Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


46596 / 76732 ←次へ | 前へ→

【35106】Re:同一データの書き出し
回答  Statis  - 06/2/21(火) 14:30 -

引用なし
パスワード
   こんにちは

コード記載のファイルと比較するファイルは同じフォルダにする事

コード記載のファイルにUserFom1を作りそこにコンボボックスを
ひとつ用意して下さい。(複数のシートを選択します。)

下記を標準モジュールに記載

Public Sh As String
Sub Test()
Dim MyFi As Variant, MyPh As String, i As Long
Dim Wb(1) As Workbook, Ch As Boolean, Ws As Worksheet
Dim C As Range, Ma As Variant, Ws1 As Worksheet, NowWb As Workbook
Dim Co As Long

Ch = True: Co = 1
MyPh = ThisWorkbook.Path & "\" 
ChDir MyPh
MyFi = Application.GetOpenFilename("Excelファイル (*.xls),*.xls", , , , True)
If VarType(MyFi) = 11 Then Exit Sub
If UBound(MyFi) <> 2 Then Exit Sub
Application.ScreenUpdating = False
Set Wb(0) = Workbooks.Open(MyFi(1))
Set Wb(1) = Workbooks.Open(MyFi(2))
If Wb(0).Sheets.Count > 1 Then
  Call Chekc(Wb(0))
ElseIf Wb(1).Sheets.Count > 1 Then
  Call Chekc(Wb(1))
  Ch = False
End If
Application.ScreenUpdating = True
UserForm1.Show
If Sh = "" Then GoTo End_Len
If Ch Then
  Set Ws = Wb(0).Worksheets(Sh)
  Set Ws1 = Wb(1).Worksheets(1)
Else
  Set Ws = Wb(1).Worksheets(Sh)
  Set Ws1 = Wb(0).Worksheets(1)
End If
Application.ScreenUpdating = False
Set NowWb = Workbooks.Add(1)
For Each C In Ws.Range("F1", Ws.Range("F65536").End(xlUp))
  Ma = Application.Match(C.Value, Ws1.Columns(6), 0)
  If Not IsError(Ma) Then
   C.EntireRow.Copy NowWb.Worksheets(1).Cells(Co, 1)
   Co = Co + 1
  End If
Next C
Application.ScreenUpdating = True
End_Len:
 Wb(0).Close False
 Wb(1).Close False
 Set Ws = Nothing: Set Ws1 = Nothing
 Set Wb(0) = Nothing: Set Wb(1) = Nothing
 Set NowWb = Nothing
End Sub

Private Sub Chekc(Wb1 As Workbook)
Dim ii As Long
For ii = 1 To Wb1.Sheets.Count
   UserForm1.ComboBox1.AddItem Sheets(ii).Name
Next ii
End Sub

下記をUserForm1のモジュールに記載

Private Sub ComboBox1_Change()
If Me.ComboBox1.Value = "" Then
  MsgBox "シート名を選択して下さい。"
Else
  Sh = Me.ComboBox1.Value
  Unload Me
End If
End Sub


流れ:Sub Test()を実行すると「ファイル開く」が出ますので、該当のファイルを2つ選択して「開く」を押す。
UserForm1が表示しますのでコンボボックスでシートを選択(複数あるシートを選択させます)
後は新しいファイルを作りコピーします。

ではお試しを

1 hits

【35088】同一データの書き出し 超初心者 06/2/21(火) 12:04 質問
【35094】Re:同一データの書き出し Statis 06/2/21(火) 13:00 発言
【35095】Re:同一データの書き出し 超初心者 06/2/21(火) 13:04 発言
【35097】Re:同一データの書き出し 超初心者 06/2/21(火) 13:06 発言
【35099】Re:同一データの書き出し Statis 06/2/21(火) 13:34 発言
【35104】Re:同一データの書き出し 超初心者 06/2/21(火) 14:02 発言
【35106】Re:同一データの書き出し Statis 06/2/21(火) 14:30 回答
【35108】Re:同一データの書き出し 超初心者 06/2/21(火) 15:47 発言
【35109】Re:同一データの書き出し Statis 06/2/21(火) 16:05 発言
【35182】Re:同一データの書き出し 超初心者 06/2/23(木) 13:12 お礼

46596 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free