0

ユーザーフォームのコンボボックスで行われた選択に基づいて、選択した内容を目的のワークシートに送信するにはどうすればよいですか。たとえば、ワークブックに 12 個のワークシートがあるとします。各ワークシートの名前は、その年の月の名前です。コンボ ボックスの選択は、その年のすべての月です。1月～12月。コンボ ボックスで 1 月を選択した場合、ユーザー フォームの他のすべてのエントリを 1 月のワークシートに移動します。2 月を選択すると、他のテキスト ボックスのすべてのエントリが 2 月のワークシートに移動するようになります。どうすればこれを達成できますか?? どんな助けでも大いに感謝します!!!

コードを再編集しました。唯一の問題は、cellVal4 = Me.tbDate.Text です。エラーは、強調表示された .Text にあります。また、フォームを送信すると、エントリごとに新しい行が追加されず、最初のエントリがあった同じ行が変更されます。

            Option Explicit

ワークシートとして薄暗いワークシート

Private Sub btnSubmit_Click() Application.EnableEvents = False

Dim ssheet As Workbook Dim cellVal1 As String, cellVal2 As String, cellVal3 As String, cellVal4 As String, cellVal5 As String, cellVal6 As String, cellVal7 As String, cellVal8 As String, cellVal9 As String, cellVal10 As String, cellVal11 As String, cellVal12 As String Dim cellVal13 As String, cellVal14 As String, cellVal15 As String, cellVal16 As String, cellVal17 As String, cellVal18 As String, cellVal19 As String, cellVal20 As String, cellVal21 As String, cellVal22 As String Dim cellVal23 As String, cellVal24 As String 、cellVal25 As String、cellVal26 As String、cellVal27 As String、cellVal28 As String、cellVal29 As String、cellVal30 As String、cellVal31 As String、cellVal32 As String、cellVal33 As String、cellVal34 As String

Dim shtCmb As String
Dim RwLast As Long

shtCmb = Me.cmbListItem1.Value
If shtCmb = "" Then
    MsgBox "Please choose a month.", vbOKOnly
    Me.cmbListItem1.SetFocus
End If

cellVal1 = Me.cmbListItem1.Text
cellVal2 = Me.cmbListItem2.Text
cellVal3 = Me.cmbListItem3.Text
cellVal4 = Me.TextBox31.Text
cellVal5 = Me.TextBox1.Text
cellVal6 = Me.TextBox2.Text
cellVal7 = Me.TextBox3.Text
cellVal8 = Me.TextBox4.Text
cellVal9 = Me.TextBox5.Text
cellVal10 = Me.TextBox6.Text
cellVal11 = Me.TextBox7.Text
cellVal12 = Me.TextBox8.Text
cellVal13 = Me.TextBox9.Text
cellVal14 = Me.TextBox10.Text
cellVal15 = Me.TextBox11.Text
cellVal16 = Me.TextBox12.Text
cellVal17 = Me.TextBox13.Text
cellVal18 = Me.TextBox14.Text
cellVal19 = Me.TextBox15.Text
cellVal20 = Me.TextBox16.Text
cellVal21 = Me.TextBox17.Text
cellVal22 = Me.TextBox18.Text
cellVal23 = Me.TextBox19.Text
cellVal24 = Me.TextBox20.Text
cellVal25 = Me.TextBox21.Text
cellVal26 = Me.TextBox22.Text
cellVal27 = Me.TextBox23.Text
cellVal28 = Me.TextBox24.Text
cellVal29 = Me.TextBox25.Text
cellVal30 = Me.TextBox26.Text
cellVal31 = Me.TextBox27.Text
cellVal32 = Me.TextBox28.Text
cellVal33 = Me.TextBox29.Text
cellVal34 = Me.TextBox30.Text

RwLast = Worksheets(shtCmb).Range("AI" & Worksheets(shtCmb).Rows.Count).End(xlUp).Row

Worksheets(shtCmb).Range("AI" & RwLast + 1).Value = cellVal1
Worksheets(shtCmb).Range("AJ" & RwLast + 1).Value = cellVal2
Worksheets(shtCmb).Range("A" & RwLast + 1).Value = cellVal3
Worksheets(shtCmb).Range("AH" & RwLast + 1).Value = cellVal4
Worksheets(shtCmb).Range("B" & RwLast + 1).Value = cellVal5
Worksheets(shtCmb).Range("C" & RwLast + 1).Value = cellVal6
Worksheets(shtCmb).Range("D" & RwLast + 1).Value = cellVal7
Worksheets(shtCmb).Range("E" & RwLast + 1).Value = cellVal8
Worksheets(shtCmb).Range("F" & RwLast + 1).Value = cellVal9
Worksheets(shtCmb).Range("G" & RwLast + 1).Value = cellVal10
Worksheets(shtCmb).Range("H" & RwLast + 1).Value = cellVal11
Worksheets(shtCmb).Range("I" & RwLast + 1).Value = cellVal12
Worksheets(shtCmb).Range("J" & RwLast + 1).Value = cellVal13
Worksheets(shtCmb).Range("K" & RwLast + 1).Value = cellVal14
Worksheets(shtCmb).Range("L" & RwLast + 1).Value = cellVal15
Worksheets(shtCmb).Range("M" & RwLast + 1).Value = cellVal16
Worksheets(shtCmb).Range("N" & RwLast + 1).Value = cellVal17
Worksheets(shtCmb).Range("O" & RwLast + 1).Value = cellVal18
Worksheets(shtCmb).Range("P" & RwLast + 1).Value = cellVal19
Worksheets(shtCmb).Range("Q" & RwLast + 1).Value = cellVal20
Worksheets(shtCmb).Range("R" & RwLast + 1).Value = cellVal21
Worksheets(shtCmb).Range("S" & RwLast + 1).Value = cellVal22
Worksheets(shtCmb).Range("T" & RwLast + 1).Value = cellVal23
Worksheets(shtCmb).Range("U" & RwLast + 1).Value = cellVal24
Worksheets(shtCmb).Range("V" & RwLast + 1).Value = cellVal25
Worksheets(shtCmb).Range("W" & RwLast + 1).Value = cellVal26
Worksheets(shtCmb).Range("X" & RwLast + 1).Value = cellVal27
Worksheets(shtCmb).Range("Y" & RwLast + 1).Value = cellVal28
Worksheets(shtCmb).Range("Z" & RwLast + 1).Value = cellVal29
Worksheets(shtCmb).Range("AA" & RwLast + 1).Value = cellVal30
Worksheets(shtCmb).Range("AB" & RwLast + 1).Value = cellVal31
Worksheets(shtCmb).Range("AC" & RwLast + 1).Value = cellVal32
Worksheets(shtCmb).Range("AD" & RwLast + 1).Value = cellVal33
Worksheets(shtCmb).Range("AF" & RwLast + 1).Value = cellVal34

Application.EnableEvents = True

End Sub

Private Sub cmbListItem1_Change()

End Sub

Private Sub optionCancel_Click()
Unload Me
End Sub

Private Sub UserForm_Initialize()

    Dim SH As Worksheet
    Dim Entry As Variant

    ' MonthName(Month(Now)) - Will return the name of the current Month
    For Each SH In ThisWorkbook.Worksheets
        If SH.Name = MonthName(month(Now)) Then
            Set WrkSheet = SH
            Exit For
        End If
    Next

    'fill the combo box
    With Me.cmbListItem1
        For Each Entry In [List1]
            .AddItem Entry
        Next Entry
        .Value = MonthName(month(Now))
    End With
    'fill the combo box
    With Me.cmbListItem2
        For Each Entry In [List2]
            .AddItem Entry
        Next Entry
    End With
    'fill the combo box
    With Me.cmbListItem3
        For Each Entry In [List3]
            .AddItem Entry
        Next Entry
    End With

End Sub
4

2 に答える 2

1

UserForm コード内で次のようなことを試すことができます。

Option Explicit
Dim WrkSheet As Worksheet

Private Sub ComboBox1_Change()
Dim SH As Worksheet
For Each SH In ThisWorkbook.Worksheets
    If SH.Name = Me.ComboBox1.Value Then
        Set WrkSheet = SH
        Exit For
    End If
Next
End Sub

次に、UserForm コードの残りの部分で、次の方法で正しいシートを参照できるようにする必要があります。

MsgBox WrkSheet.Range("A1").Value

編集：コードを追加

Option Explicit
Dim WrkSheet As Worksheet

Private Sub btnSubmit_Click()
    Dim SSheet As Workbook
    Dim NR As Long

    NR = SSheet.Cells(Rows.Count, 1).Row + 1
    'Not sure what you are trying to do below ???
    SSheet.Cells(NR, 1) = "???"
End Sub

Private Sub cmbListItem1_Change()
    Dim SH As Worksheet
    For Each SH In ThisWorkbook.Worksheets
        If SH.Name = Me.ComboBox1.Value Then
            Set WrkSheet = SH
            Exit For
        End If
    Next
    WrkSheet.Range("AI2").Value = Me.cmbListItem1.Text
End Sub

Private Sub cmbListItem2_Change()
    WrkSheet.Range("AJ2").Value = Me.cmbListItem2.Text
End Sub

Private Sub cmbListItem3_Change()
    WrkSheet.Range("A2").Value = Me.cmbListItem3.Text
End Sub

Private Sub tbDate_Click()
    WrkSheet.Range("AH2").Value = Me.tbDate.Text
End Sub

Private Sub TextBox1_Change()
    WrkSheet.Range("B2").Value = Me.TextBox1.Text
End Sub

Private Sub TextBox2_Change()
    WrkSheet.Range("C2").Value = Me.TextBox2.Text
End Sub

Private Sub TextBox3_Change()
    WrkSheet.Range("D2").Value = Me.TextBox3.Text
End Sub

Private Sub UserForm_Initialize()
    Dim SH As Worksheet
    Dim Entry As Variant

    ' MonthName(Month(Now)) - Will return the name of the current Month
    For Each SH In ThisWorkbook.Worksheets
        If SH.Name = MonthName(Month(Now)) Then
            Set WrkSheet = SH
            Exit For
        End If
    Next
    Me.tbDate = Date
    'fill the combo box
    With Me.cmbListItem1
        For Each Entry In [List1]
            .AddItem Entry
        Next Entry
        .Value = MonthName(Month(Now))
    End With
    'fill the combo box
    With Me.cmbListItem2
        For Each Entry In [List2]
            .AddItem Entry
        Next Entry
    End With
    'fill the combo box
    With Me.cmbListItem3
        For Each Entry In [List3]
            .AddItem Entry
        Next Entry
    End With
End Sub

上記はテストされていませんが、試してみて、問題の解決に役立つかどうかを確認してください。

編集: 以下に別のコード バリエーションを追加: 以下は、すべての UserForm 値をシートに追加し、リストで選択した月名を使用します。あなたの例で使用されている元の列を保持しました。

Option Explicit
Dim WrkSheet As Worksheet

Private Sub btnSubmit_Click()
    Dim NR As Long
    Application.ScreenUpdating = False
    With WrkSheet
        NR = .UsedRange.Rows.Count + 1
            'If there is a specific column (Example: A) you can use
            'NR = .Range("A" & .UsedRange.Rows.Count).End(xlUp).Row + 1
        .Range("AI" & NR).Value = Me.cmbListItem1.Text
        .Range("AJ" & NR).Value = Me.cmbListItem2.Text
        .Range("A" & NR).Value = Me.cmbListItem3.Text
        .Range("AH" & NR).Value = Me.tbDate.Text
        .Range("B" & NR).Value = Me.TextBox1.Text
        .Range("C" & NR).Value = Me.TextBox2.Text
        .Range("D" & NR).Value = Me.TextBox3.Text
    End With
    Application.ScreenUpdating = True
End Sub

Private Sub cmbListItem1_Change()
    Dim SH As Worksheet
    For Each SH In ThisWorkbook.Worksheets
        If SH.Name = Me.ComboBox1.Value Then
            Set WrkSheet = SH
            Exit For
        End If
    Next
End Sub

Private Sub UserForm_Initialize()
    Dim SH As Worksheet
    Dim Entry As Variant
    Set WrkSheet = Sheet3 ' You can Change or Remove This if you choose
    ' MonthName(Month(Now)) - Will return the name of the current Month
    For Each SH In ThisWorkbook.Worksheets
        If SH.Name = MonthName(Month(Now)) Then
            Set WrkSheet = SH
            Exit For
        End If
    Next
    Me.tbDate = Date
    'fill the combo box
    With Me.cmbListItem1
        For Each Entry In [List1]
            .AddItem Entry
        Next Entry
        .Value = MonthName(Month(Now))
    End With
    'fill the combo box
    With Me.cmbListItem2
        For Each Entry In [List2]
            .AddItem Entry
        Next Entry
    End With
    'fill the combo box
    With Me.cmbListItem3
        For Each Entry In [List3]
            .AddItem Entry
        Next Entry
    End With
End Sub
于 2013-10-22T15:47:25.877 に答える
0

最初のコンボボックスにシートの名前しかない場合は、代わりにこれを使用してコードを大幅に短縮できます。

Private Sub cmbListItem1_Change()

Dim cellVal as String
Dim shtCmb As String
shtCmb = Me.cmbListItem1.Value
cellVal = Me.cmbListItem1.Text

If shtCmb = "" Then
    MsgBox "Please choose a month.", vbOKOnly
    Me.cmbListItem1.SetFocus
End If

Worksheets(shtCmb).Range("AI2").Value = cellVal    
End Sub

コンボボックスの入力ごとに、セルの値の出力変数を変更するだけです。

Private Sub cmbListItem2_Change()

Dim cellVal as String
Dim shtCmb As String
shtCmb = Me.cmbListItem1.Value
cellVal = Me.cmbListItem2.Text

If shtCmb = "" Then
    MsgBox "Please choose a month.", vbOKOnly
    Me.cmbListItem1.SetFocus
End If

Worksheets(shtCmb).Range("AJ2").Value = cellVal
End Sub

ただし、このコードは、変更が行われるたびに、これらのシートのセルの値を変更する必要があります。それがあなたが望むものなら、これでうまくいくはずです。入力ボタンをクリックしたときにすべての値を入力したい場合は、それもお手伝いできます。

編集：

コードを変更して、承認ボタンのクリックイベントでセルを更新し (とにかく承認ボタンであると想定しています)、既にそこにあるものの下にある次の空のセルを更新しました。このコードは、一部の値がすでに行 1 にあると想定しています。おそらくヘッダーです。実際のワークブックではなく、ワークブックのコピーでこれを試してみてください。うまくいくはずです。作業データのコピーがないため、これをテストできません。

Private Sub btnSubmit_Click()
Dim ssheet As Workbook
Dim cellVal1 As String, cellVal2 As String, cellVal3 As String, cellVal4 As String, cellVal5 As String
Dim cellVal6 As String, cellVal7 As String
Dim shtCmb As String
Dim RwLast As Long
shtCmb = Me.cmbListItem1.Value

If shtCmb = "" Then
    MsgBox "Please choose a month.", vbOKOnly
    Me.cmbListItem1.SetFocus
End If

cellVal1 = Me.cmbListItem1.Text
cellVal2 = Me.cmbListItem2.Text
cellVal3 = Me.cmbListItem3.Text
cellVal4 = Me.tbDate.Text
cellVal5 = Me.TextBox1.Text
cellVal6 = Me.TextBox2.Text
cellVal7 = Me.TextBox3.Text

RwLast = Range("AI" & ActiveSheet.Rows.Count).End(xlUp).Row

Worksheets(shtCmb).Range("AI" & RwLast + 1).Value = cellVal1
Worksheets(shtCmb).Range("AJ" & RwLast + 1).Value = cellVal2
Worksheets(shtCmb).Range("A" & RwLast + 1).Value = cellVal3
Worksheets(shtCmb).Range("AH" & RwLast + 1).Value = cellVal4
Worksheets(shtCmb).Range("B" & RwLast + 1).Value = cellVal5
Worksheets(shtCmb).Range("C" & RwLast + 1).Value = cellVal6
Worksheets(shtCmb).Range("D" & RwLast + 1).Value = cellVal7

End Sub

Private Sub UserForm_Initialize()

Me.tbDate = Date


'fill the combo box
For Each entry In [List1]
    Me.cmbListItem1.AddItem entry
Next entry

'fill the combo box
For Each entry In [List2]
    Me.cmbListItem2.AddItem entry

Next entry

'fill the combo box
For Each entry In [List3]
    Me.cmbListItem3.AddItem entry

Next entry



End Sub

これは私の側でこのコードを完成させる非常に不器用な方法であることに注意してください.範囲とエントリ値の間を反復するためのより良い方法があるはずですが、私はマスターではないので、これがコードを完成させる最も簡単な方法です.

于 2013-10-22T19:46:34.690 に答える