2017-01-20 7 views
-1

これを読む時間がかかる人には、別のワークシートからuserformで選択された変数をワークシート(レポート)に取り込みます(そして、卑劣な 'All'オプションを投げるかもしれません)

私は、ユーザーフォームの選択されたコンボボックス変数に基づいて、あるワークシートから別のワークシートにデータをプルするための簡単な「ガバナンスレポートの実行」ボタンを作成しようとしています。

これまでのところ、私は仕事に取得することはできませんどのような私の2つのワークシート(「データを報告ガバナンス」と「ガバナンス報告書」、ボタン「btnrun」、およびセットアップユーザーフォーム「RunGovernance」。

を設定しています以下は私のことができるようにしたいと思い

...コンボボックスから変数をユーザーフォーム上で選択された場合、私はそれだけでこれらの変数を組み込んだデータ行を移入することができません...

です可能であれば、コンボボックスから1つ以上の変数を選択し、それぞれのコンボボックスに「すべて」オプションを入れて、このgrを持っているようにしますab特定の変数に使用可能なすべてのデータ...

これまでのコードは以下のとおりです。

Private Sub btnrun_Click() 
    Dim sdsheet As Worksheet, grsheet As Worksheet 
    Set sdsheet = ThisWorkbook.Sheets("Governance Reporting Data") 
    Set grsheet = ThisWorkbook.Sheets("Governance Report") 
    Dim match As Boolean 
    match = False 

    If sdsheet.Cells(Rows.Count, 4).End(xlUp).Row = 1 Then 
     sdlr = 2 
    Else 
     sdlr = sdsheet.Cells(Rows.Count, 4).End(xlUp).Row 
    End If 

    If grsheet.Cells(Rows.Count, 1).End(xlUp).Row = 1 Then 
     grlr = 2 
    Else 
     grlr = grsheet.Cells(Rows.Count, 1).End(xlUp).Row 
    End If 

    Me.Hide 

    'find selected data and populate in report spreadsheet 

    y = 2 ' starting row 

    'month 
    For x = 5 To sdlr 
     If sdsheet.Cells(x, 2) = Me.cmbmonth Then 
      'put on grsheet 
      grsheet.Cells(y, 1) = sdsheet.Cells(x, 3) 
      grsheet.Cells(y, 2) = sdsheet.Cells(x, 4) 
      grsheet.Cells(y, 3) = sdsheet.Cells(x, 5) 
      grsheet.Cells(y, 4) = sdsheet.Cells(x, 6) 
      grsheet.Cells(y, 5) = sdsheet.Cells(x, 7) 
      grsheet.Cells(y, 6) = sdsheet.Cells(x, 8) 
      grsheet.Cells(y, 7) = sdsheet.Cells(x, 9) 
      grsheet.Cells(y, 8) = sdsheet.Cells(x, 10) 
      grsheet.Cells(y, 9) = sdsheet.Cells(x, 11) 
      y = y + 1 
     Else 
      If sdsheet.Cells(x, 2) <> Me.cmbmonth Then 
       match = False 
       Exit For 
      End If 
     End If 

     'provider 
     If sdsheet.Cells(x, 4) = Me.cmbprovider Then 
      'put on grsheet 
      grsheet.Cells(y, 1) = sdsheet.Cells(x, 3) 
      grsheet.Cells(y, 2) = sdsheet.Cells(x, 4) 
      grsheet.Cells(y, 3) = sdsheet.Cells(x, 5) 
      grsheet.Cells(y, 4) = sdsheet.Cells(x, 6) 
      grsheet.Cells(y, 5) = sdsheet.Cells(x, 7) 
      grsheet.Cells(y, 6) = sdsheet.Cells(x, 8) 
      grsheet.Cells(y, 7) = sdsheet.Cells(x, 9) 
      grsheet.Cells(y, 8) = sdsheet.Cells(x, 10) 
      grsheet.Cells(y, 9) = sdsheet.Cells(x, 11) 
      y = y + 1 
     Else 
      If grsheet.Cells(x, 4) <> Me.cmbprovider Then 
       match = False 
       Exit For 
      End If 
     End If 

     'contract officer 
     If sdsheet.Cells(x, 5) = Me.cmbcontractofficer Then 
      'put on grsheet 
      grsheet.Cells(y, 1) = sdsheet.Cells(x, 3) 
      grsheet.Cells(y, 2) = sdsheet.Cells(x, 4) 
      grsheet.Cells(y, 3) = sdsheet.Cells(x, 5) 
      grsheet.Cells(y, 4) = sdsheet.Cells(x, 6) 
      grsheet.Cells(y, 5) = sdsheet.Cells(x, 7) 
      grsheet.Cells(y, 6) = sdsheet.Cells(x, 8) 
      grsheet.Cells(y, 7) = sdsheet.Cells(x, 9) 
      grsheet.Cells(y, 8) = sdsheet.Cells(x, 10) 
      grsheet.Cells(y, 9) = sdsheet.Cells(x, 11) 
      y = y + 1 
     Else 
      If grsheet.Cells(x, 5) <> Me.cmbcontractofficer Then 
       match = False 
       Exit For 
      End If 
     End If 

     'program 
     If sdsheet.Cells(x, 6) = Me.cmbprogram Then 
      'put on grsheet 
      grsheet.Cells(y, 1) = sdsheet.Cells(x, 3) 
      grsheet.Cells(y, 2) = sdsheet.Cells(x, 4) 
      grsheet.Cells(y, 3) = sdsheet.Cells(x, 5) 
      grsheet.Cells(y, 4) = sdsheet.Cells(x, 6) 
      grsheet.Cells(y, 5) = sdsheet.Cells(x, 7) 
      grsheet.Cells(y, 6) = sdsheet.Cells(x, 8) 
      grsheet.Cells(y, 7) = sdsheet.Cells(x, 9) 
      grsheet.Cells(y, 8) = sdsheet.Cells(x, 10) 
      grsheet.Cells(y, 9) = sdsheet.Cells(x, 11) 
      y = y + 1 
     Else 
      If grsheet.Cells(x, 6) <> Me.cmbprogram Then 
       match = False 
       Exit For 
      End If 
     End If 

     'issue 
     If sdsheet.Cells(x, 7) = Me.cmbissue Then 
      'put on grsheet 
      grsheet.Cells(y, 1) = sdsheet.Cells(x, 3) 
      grsheet.Cells(y, 2) = sdsheet.Cells(x, 4) 
      grsheet.Cells(y, 3) = sdsheet.Cells(x, 5) 
      grsheet.Cells(y, 4) = sdsheet.Cells(x, 6) 
      grsheet.Cells(y, 5) = sdsheet.Cells(x, 7) 
      grsheet.Cells(y, 6) = sdsheet.Cells(x, 8) 
      grsheet.Cells(y, 7) = sdsheet.Cells(x, 9) 
      grsheet.Cells(y, 8) = sdsheet.Cells(x, 10) 
      grsheet.Cells(y, 9) = sdsheet.Cells(x, 11) 
      y = y + 1 
     Else 
      If grsheet.Cells(x, 7) <> Me.cmbissue Then 
       match = False 
       Exit For 
      End If 
     End If 

     'status 
     If sdsheet.Cells(x, 11) = Me.cmbstatus Then 
      'put on grsheet 
      grsheet.Cells(y, 1) = sdsheet.Cells(x, 3) 
      grsheet.Cells(y, 2) = sdsheet.Cells(x, 4) 
      grsheet.Cells(y, 3) = sdsheet.Cells(x, 5) 
      grsheet.Cells(y, 4) = sdsheet.Cells(x, 6) 
      grsheet.Cells(y, 5) = sdsheet.Cells(x, 7) 
      grsheet.Cells(y, 6) = sdsheet.Cells(x, 8) 
      grsheet.Cells(y, 7) = sdsheet.Cells(x, 9) 
      grsheet.Cells(y, 8) = sdsheet.Cells(x, 10) 
      grsheet.Cells(y, 9) = sdsheet.Cells(x, 11) 
      y = y + 1 
     Else 
      If grsheet.Cells(x, 11) <> Me.cmbstatus Then 
       match = False 
       Exit For 
      End If 
     End If 
    Next 

    'jump to report 
    grsheet.Visible = True 
    grsheet.Select 

    'print preview option 
    If Me.cbprintpreview = True Then 
     grsheet.PrintPreview 
    End If 

    'close report 
    answer = MsgBox("Would you like to close this report?", vbYesNo, "Close Report?") 

    If answer = vbYes Then 
     grsheet.Visible = False 

     'clear last report 
     grsheet.Range("A2:i" & grlr).ClearContents 
    End If 
End Sub 
+0

「と」(。つまり、行は1つだけでなく、すべての選択と一致する必要があります)を組み合わせする(別のコンボボックスで)異なる選択はありますか?また、Exit Forを呼び出して、一致しない行をヒットするとすぐにループを終了します。これは何を意味するのでしょうか? –

+0

あなたのお返事ありがとうございます、ティム!はい、私はすべての選択肢を組み合わせたいと思います。いいえ、私は一致しない行があるときにループを離れたくありません。適切なマッチのためにデータシートを検索し続けたいと思います。私はスーパー初心者ですので、適切なステートメントに時間をかけています...「Exit Fors」をすべて削除して、どこかで「And's」をポップする必要がありますか?再度、感謝します! – Jessej

答えて

0

未テスト。すべてのコンボボックスは、「すべて」のオプションを持っている前提としています

Private Sub btnrun_Click() 
    Dim sdsheet As Worksheet, grsheet As Worksheet 
    Dim sdlr As Long, grlr As Long, y As Long, x As Long 

    Set sdsheet = ThisWorkbook.Sheets("Governance Reporting Data") 
    Set grsheet = ThisWorkbook.Sheets("Governance Report") 
    Dim match As Boolean 
    match = False 

    sdlr = Application.Max(sdsheet.Cells(Rows.Count, 4).End(xlUp).Row, 2) 

    '## are you sure you want to get this here? 
    grlr = Application.Max(grsheet.Cells(Rows.Count, 1).End(xlUp).Row, 2) 
    y = 2 ' starting row << not grlr ? 

    'month 
    For x = 5 To sdlr 

     If Me.cmbmonth = "All" Or sdsheet.Cells(x, 2) = Me.cmbmonth Then 
     If Me.cmbprovider = "All" Or sdsheet.Cells(x, 4) = Me.cmbprovider Then 
     If Me.cmbcontractofficer = "All" Or sdsheet.Cells(x, 5) = Me.cmbcontractofficer Then 
     If Me.cmbprogram = "All" Or sdsheet.Cells(x, 6) = Me.cmbprogram Then 
     If Me.cmbissue = "All" Or sdsheet.Cells(x, 7) = Me.cmbissue Then 
     If Me.cmbstatus = "All" Or sdsheet.Cells(x, 11) = Me.cmbstatus Then 

      grsheet.Cells(y, 1).Resize(1, 9).Value = sdsheet.Cells(x, 3).Resize(1, 9).Value 
      y = y + 1 
      match = True 

     End If 
     End If 
     End If 
     End If 
     End If 
     End If 
    Next 


    grsheet.Visible = True 
    grsheet.Activate 

    If Me.cbprintpreview = True Then grsheet.PrintPreview 

    If MsgBox("Would you like to close this report?", vbYesNo, "Close Report?") = vbYes Then 
     grsheet.Visible = False 
     grsheet.Range("A2:I" & grlr).ClearContents '<< grlr value will not be current ? 
    End If 

End Sub 
+0

多くのありがとう、ティム。これは非常に感謝しています!それは確かに私が持っていたよりもはるかにきれいです。明確な内容については、「grlr value」はワークシート上の現在のデータに基づいており、存在するすべてのデータをクリアすると考えましたが、正しいと思われます。範囲をグラフの到達しない値に変更しました(grsheet.Range( "A2:I150")。ClearContents)。再度、感謝します! – Jessej

関連する問題