Sub DistributeData()
Dim wsInput As Worksheet
Dim wsIkkyu As Worksheet
Dim wsRakuten As Worksheet
Dim wsJalan As Worksheet
Dim lastRow As Long
Dim i As Long
' シートを設定
Set wsInput = ThisWorkbook.Sheets("データ入力用")
Set wsIkkyu = ThisWorkbook.Sheets("一休")
Set wsRakuten = ThisWorkbook.Sheets("楽天")
Set wsJalan = ThisWorkbook.Sheets("じゃらん")
' 最終行を取得
lastRow = wsInput.Cells(wsInput.Rows.Count, "A").End(xlUp).Row
' 各シートの最終行を取得して初期化
Dim ikkyuRow As Long
Dim rakutenRow As Long
Dim jalanRow As Long
ikkyuRow = wsIkkyu.Cells(wsIkkyu.Rows.Count, "A").End(xlUp).Row + 1
rakutenRow = wsRakuten.Cells(wsRakuten.Rows.Count, "A").End(xlUp).Row + 1
jalanRow = wsJalan.Cells(wsJalan.Rows.Count, "A").End(xlUp).Row + 1
' データを振り分け
For i = 2 To lastRow ' ヘッダー行を飛ばして2行目から開始
Select Case wsInput.Cells(i, 1).Value
Case "一休"
wsInput.Rows(i).Copy Destination:=wsIkkyu.Rows(ikkyuRow)
ikkyuRow = ikkyuRow + 1
Case "楽天"
wsInput.Rows(i).Copy Destination:=wsRakuten.Rows(rakutenRow)
rakutenRow = rakutenRow + 1
Case "じゃらん"
wsInput.Rows(i).Copy Destination:=wsJalan.Rows(jalanRow)
jalanRow = jalanRow + 1
End Select
Next i
End Sub
Sub CopyDataBasedOnColumnZ()
Dim wsTest As Worksheet
Dim wsUrikake As Worksheet
Dim wbTest As Workbook
Dim wbUrikake As Workbook
Dim lastRowTest As Long
Dim lastRowUrikake As Long
Dim i As Long
Dim matchFound As Boolean
Dim newFileName As String
' "テスト"ブックを開いてシートを設定
Set wbTest = Workbooks.Open("C:\path\to\your\テスト.xlsx")
Set wsTest = wbTest.Sheets("Sheet1")
' "売掛一覧表"ブックを開いてシートを設定
Set wbUrikake = Workbooks.Open("C:\path\to\your\売掛一覧表.xlsx")
Set wsUrikake = wbUrikake.Sheets("一覧表")
' "テスト"ブックの"Sheet1"の最終行を取得
lastRowTest = wsTest.Cells(wsTest.Rows.Count, "Z").End(xlUp).Row
' "売掛一覧表"の"一覧表"の列数を取得
Dim lastColUrikake As Long
lastColUrikake = wsUrikake.Cells(2, wsUrikake.Columns.Count).End(xlToLeft).Column
' "テスト"の"Sheet1"の各行をループ
For i = 2 To lastRowTest ' ヘッダー行を飛ばして2行目から開始
matchFound = False
' "売掛一覧表"の2行目をループして一致する列を探す
Dim j As Long
For j = 1 To lastColUrikake
If wsUrikake.Cells(2, j).Value = wsTest.Cells(i, "Z").Value Then
matchFound = True
' "売掛一覧表"の対象列の最終行を取得
lastRowUrikake = wsUrikake.Cells(wsUrikake.Rows.Count, j).End(xlUp).Row + 1
' 列Wの値を一致する列の次の空きセルにコピー
wsUrikake.Cells(lastRowUrikake, j).Value = wsTest.Cells(i, "W").Value
Exit For
End If
Next j
' 一致する値が見つからなかった場合の処理
If Not matchFound Then
wsTest.Rows(i).Interior.Color = RGB(255, 255, 0) ' 背景色を黄色に設定
End If
Next i
' 処理終了後、"売掛一覧表"を名前を付けて保存
newFileName = Format(Date, "mmdd") & "売掛一覧表.xlsx"
wbUrikake.SaveAs Filename:="C:\path\to\your\" & newFileName
' "売掛一覧表"を閉じない
' wbUrikake.Close ' ここはコメントアウトして閉じないようにする
' "テスト"を上書き保存して閉じない
wbTest.Save
End Sub
Sub CheckValuesAndHighlightRows()
Dim wsTest As Worksheet
Dim wsDataInput As Worksheet
Dim wbTest As Workbook
Dim wbUrikake As Workbook
Dim lastRowTest As Long
Dim lastRowDataInput As Long
Dim i As Long
Dim matchFound As Boolean
' "テスト"ブックを開いてシートを設定
Set wbTest = Workbooks.Open("C:\path\to\your\テスト.xlsx")
Set wsTest = wbTest.Sheets("Sheet1")
' "売掛一覧表"ブックを開いてシートを設定
Set wbUrikake = Workbooks.Open("C:\path\to\your\売掛一覧表.xlsx")
Set wsDataInput = wbUrikake.Sheets("データ入力用")
' "テスト"ブックの"Sheet1"の最終行を取得
lastRowTest = wsTest.Cells(wsTest.Rows.Count, "B").End(xlUp).Row
' "売掛一覧表"の"データ入力用"の最終行を取得
lastRowDataInput = wsDataInput.Cells(wsDataInput.Rows.Count, "C").End(xlUp).Row
' "テスト"の"Sheet1"の各行をループ
For i = 2 To lastRowTest ' ヘッダー行を飛ばして2行目から開始
matchFound = False
' "売掛一覧表"の"データ入力用"の各行をループして一致する値を探す
Dim j As Long
For j = 2 To lastRowDataInput ' ヘッダー行を飛ばして2行目から開始
If wsTest.Cells(i, "B").Value = wsDataInput.Cells(j, "C").Value Then
matchFound = True
' 列Wの値と列Dの値が一致するかをチェック
If wsTest.Cells(i, "W").Value <> wsDataInput.Cells(j, "D").Value Then
' 一致しない場合、背景色を水色に設定
wsTest.Rows(i).Interior.Color = RGB(173, 216, 230) ' 水色
End If
Exit For
End If
Next j
' 一致する値が見つからなかった場合の処理
If Not matchFound Then
wsTest.Rows(i).Interior.Color = RGB(255, 182, 193) ' ピンク色
End If
Next i
' "テスト"を上書き保存して閉じない
wbTest.Save
' "売掛一覧表"を閉じる
wbUrikake.Close SaveChanges:=False
End Sub