/ / Excel 2013 VBA सारणी को भरने के लिए कई उपयोक्ता - excel, vba, excel-vba

Excel 2013 VBA तालिका को भरने के लिए कई उपयोगकर्ता-एक्सेल, vba, एक्सेल-vba

मैं के लिए सरल एक्सेल आवेदन पर काम कर रहा हूँकई उपयोगकर्ता जो प्रक्रिया के विभिन्न चरणों के दौरान डेटा दर्ज करेंगे। दुर्भाग्य से मैं तालिका के एक पंक्ति में कई उपयोगकर्ता के डेटा को संग्रहीत करने के साथ समस्याओं को पूरा किया।

मैं यह स्पष्ट करने की कोशिश करूंगा कि मैं जितना स्पष्ट हो सकता हूं उसके बारे में पूरी बात क्या है

उदाहरण के प्रयोजनों के लिए मैंने एप्लिकेशन को "मूवी टाइम कंट्रोल" कहा। आइए कल्पना करें कि यह फोकस पर देखी गई फिल्मों को नियंत्रित करने का एक उपकरण है:

  • जब फिल्म शुरू हुई,
  • यदि प्रदर्शन के दौरान कुछ विराम थे (और क्यों)
  • जब फिल्म को फिर से शुरू किया गया (ब्रेक कितना समय लगा, और कितने ब्रेक हुए और आगे क्या कार्रवाई की गई)
  • अगर फिल्म का गर्भपात कब, कब और क्यों हुआ?
  • जब फिल्म खत्म हुई।

एप्लिकेशन सेगमेंट का मेनू नीचे दिए गए स्क्रीनशॉट पर दिखेगा:

यहां छवि विवरण दर्ज करें

प्रत्येक बटन के लिए अलग-अलग यूजरफॉर्म असाइन किया गया है। प्रत्येक रूप में दर्ज किए गए डेटा को स्टोर किया जाना चाहिए विशिष्ट शीट में एक पंक्ति.

उपयोगकर्ता की कार्यक्षमता:

  1. MOVIE START: मूवी के शीर्षक, दिनांक और समय के साथ तालिका में प्रविष्टि बनाना जब इसकी शुरुआत हुई।
  2. MOVIE BREAK: पहले से परिभाषित फिल्म के शीर्षक के आधार पर, तिथि और समय, ब्रेक का कारण (ड्रॉप-डाउन सूची या पाठ बॉक्स से यदि मानक नहीं है) को भरना। फ़ंक्शन का उपयोग तीन बार (तीन ब्रेक) तक किया जा सकता है।
  3. MOVIE RESTART: यदि ब्रेक हुआ है, तो मूवी के दोबारा शुरू होने की तिथि, समय के बारे में जानकारी भरना और ब्रेक के पहले परिभाषित कारण से निपटने के लिए क्या कार्रवाई की गई है। प्रत्येक ब्रेक के लिए (संभव तीन) फ़ंक्शन का उपयोग किया जा सकता है।
  4. MOVIE ABORT (दिनांक और समय) मूवी को निरस्त कर दिया गया है (जारी रखने का इरादा नहीं)
  5. फिल्म (तिथि और समय) समाप्त होने पर फिल्म समाप्त हो गई।

जहां समस्याएं हुईं (प्रश्न):

  1. जब पहली पंक्ति से डेटा दर्ज किया जाता है, तोविशिष्ट शीर्षक के साथ प्रविष्टि तालिका अलग शीट में बनाई गई है। इस प्रविष्टि के आधार पर, सभी अन्य उपयोगकर्ताओं के शीर्षक कॉम्बोक्स को उन शीर्षकों को सूचीबद्ध करना चाहिए जो शुरू नहीं किए गए थे या समाप्त नहीं किए गए थे - बस "खुले शीर्षक" को जल्दी से चुनने और शीर्षक से संबंधित अन्य जानकारी को भरने के लिए। कॉम्बोक्स में "खुले मामलों" को सूचीबद्ध करने के लिए मैक्रो कैसे बनाएं?
  2. मैं यह नहीं पता लगा सका कि बाकी को कैसे स्थानांतरित किया जाएतालिका की एक ही पंक्ति के लिए डेटा लेकिन विशिष्ट फिल्म शीर्षक के साथ प्रविष्टि बनाने के बाद सभी रूपों से अलग कॉलम। महत्वपूर्ण बात यह है कि डेटा को केवल संबंधित शीर्षक के साथ पंक्ति में जोड़ा जा सकता है (पहले प्रश्न से कॉम्बोक्स से चुना गया)। क्या आप मैक्रो के साथ मेरी मदद कर सकते हैं?

मैक्रो मैंने अब तक बनाया (मैं VBA के साथ बहुत शुरुआती हूं, समझने के लिए धन्यवाद):

MOVIE START: मूवी शीर्षक के साथ प्रविष्टि बनाने के लिए।

Private Sub movie_start_save_Click()

If MsgBox("ARE YOU SURE?", vbYesNo, "Please confirm") = vbYes Then

Dim emptyRow As Long

"Make Sheet2 active
Sheet2.Activate

"Determine emptyRow
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1

"Transfer information
Cells(emptyRow, 1).Value = Movie_Title_Box.Value
Cells(emptyRow, 2).Value = Start_Date_Box.Value
Cells(emptyRow, 3).Value = Start_Time_Box.Value
"Closing the form
Unload Me
"Back to MENU
Sheet1.Select
End If
End Sub


Private Sub movie_start_cancel_Click()

Unload Me

End Sub

MOVIE BREAK: समय और कारण को परिभाषित करने के लिए (डेटा स्थानांतरित नहीं किया जा सकता):

Private Sub UserForm_Initialize()

"Fill ReasonComboBox
With ReasonComboBox
.AddItem "Tea"
.AddItem "Coffee"
.AddItem "Popcorn"
.AddItem "Dinner"
.AddItem "Not standard"
End With

"Default text in the reason box
ReasonTextBox.ForeColor = &HC0C0C0 "<~~ Grey Color
ReasonTextBox.Text = "In case of "not standard" reason leave your comment here"
movie_break_cancel.SetFocus "<~~ This is required so that the focus moves from TB

End Sub
"Default text in the reason box - disapearing when you want to edit
Private Sub ReasonTextBox_Enter()
With ReasonTextBox
If .Text = "In case of "not standard" reason leave your comment here" Then
.ForeColor = &H80000008 "<~ Black Color
.Text = ""
End If
End With
End Sub
"Default text in the reason box - somehow disappearing for good, but ok
Private Sub ReasonTextBox_AfterUpdate()
With ReasonTextBox
If .Text = "" Then
.ForeColor = &H80000008
.Text = ""
End If
End With
End Sub

"Cancel Button
Private Sub movie_break_cancel_Click()

Unload Me

End Sub

बाकी वास्तव में कुछ मतभेदों के साथ समान है।


एक्सेल फाइल डाउनलोड करने के लिए लिंक:

https://drive.google.com/file/d/0BxFSL2h-9qflQjRzNTQ2ZlhJNjA/view?usp=sharing

उम्मीद है कि मैंने इसे समझने के लिए खुद को पर्याप्त स्पष्ट किया। घणी खम्मां!

उत्तर:

जवाब के लिए 0 № 1

नीचे मेरे उदाहरण में, मैं दिखाता हूं कि कैसे कॉन्फ़िगर किया जाएComboBox डेटा के कई स्तंभों को रखने के लिए और बाद में मूल्यों को पुनः प्राप्त करने के लिए। यह आपको ComboBox में मूवी डेटा के साथ पंक्ति संख्या को संग्रहीत करने की अनुमति देगा।

"कंबोबॉक्स के लिए समाप्त नौकरियों के लिए फ़िल्टरिंग नहीं निजी उप उपयोगकर्ताForm_Initialize () Dim ws As Worksheet डिम एक्स अस लॉन्ग

    With Me.Movie_Title_ComboBox
.ColumnCount = 4
.ColumnWidths = "0 pt;250 pt;90 pt; 90 pt;"
".ListWidth = 500
.TextColumn = 2
.BoundColumn = 1
End With

Set ws = Sheet2
With ws
For x = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
If .Cells(x, 4).Value = "" Then
AddItems Me.Movie_Title_ComboBox, x, .Cells(x, 1).Value, Format(.Cells(x, 3).Value, "MM/DD/YYYY"), Format(.Cells(x, 3).Value, "HH:MM")
End If
Next
End With
End Sub

Private Sub Movie_Title_ComboBox_Change()
With Me.Movie_Title_ComboBox
If .ListIndex > -1 Then
Finish_Date_Box.Value = .List(.ListIndex, 2)
End If
End With
End Sub

Private Sub movie_finished_save_Click()
With Sheet2
.Cells(Me.Movie_Title_ComboBox.Value, 4) = Me.Finish_Date_Box.Value
.Cells(Me.Movie_Title_ComboBox.Value, 5) = Me.Start_Time_Box.Value
End With
End Sub

इस फ़ंक्शन को एक सार्वजनिक कोड मॉड्यूल में जोड़ें ताकि यह आपके सभी उपयोगकर्ता के लिए उपलब्ध हो।

Sub AddItems(oComboBox As MSForms.ComboBox, ParamArray Items() As Variant)
Dim x As Long

With oComboBox
.AddItem Items(0)
For x = 1 To UBound(Items)
.List(.ListCount - 1, x) = Items(x)
Next
End With

End Sub