Sub 獲得件数抽出()
Dim destSheet As Worksheet
Dim srcSheet As Worksheet
Dim lastRowDest As Long
Dim lastRowSrc As Long
Dim destRange As Range
Dim cell As Range
' 貼付シートを設定
Set destSheet = ThisWorkbook.Sheets("貼付") ' 貼付シートの名前に変更してください
' CSR集計シートを設定
Set srcSheet = ThisWorkbook.Sheets("CSR集計") ' CSR集計シートの名前に変更してください
'''''''''''''''''''''''''''''''''''''''''
''''''''以下シンスタの処理''''''
' 貼付シートのD列の最終行を取得
lastRowDest = destSheet.Cells(destSheet.Rows.Count, "D").End(xlUp).Row
' CSR集計シートのB列の最終行を取得
lastRowSrc = srcSheet.Cells(srcSheet.Rows.Count, "B").End(xlUp).Row
' 貼付シートのD列を範囲として取得
Set destRange = destSheet.Range("D8:D" & lastRowDest)
' H列にVLOOKUP関数を適用
For Each cell In destRange
cell.Offset(0, 4).Formula = "=IFERROR(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",2,0),"""")"
Next cell
' J列にVLOOKUP関数を適用
For Each cell In destRange
cell.Offset(0, 6).Formula = "=IFERROR(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",3,0),"""")"
Next cell
' 結果が0の場合は空白にするために数式を値に変換
' 数式を値に変換する
destSheet.Range("H8:H" & lastRowDest).Value = destSheet.Range("H8:H" & lastRowDest).Value
destSheet.Range("J8:J" & lastRowDest).Value = destSheet.Range("J8:J" & lastRowDest).Value
'''''''''''''''''''''''''''''''''''''''''
''''''''以下迷惑ブロックの処置''''''
' 貼付シートのD列の最終行を取得
lastRowDest = destSheet.Cells(destSheet.Rows.Count, "K").End(xlUp).Row
' CSR集計シートのB列の最終行を取得
lastRowSrc = srcSheet.Cells(srcSheet.Rows.Count, "B").End(xlUp).Row
' 貼付シートのD列を範囲として取得
Set destRange = destSheet.Range("K8:K" & lastRowDest)
' H列にVLOOKUP関数を適用
For Each cell In destRange
cell.Offset(0, 4).Formula = "=IFERROR(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",4,0),"""")"
Next cell
' J列にVLOOKUP関数を適用
For Each cell In destRange
cell.Offset(0, 6).Formula = "=IFERROR(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",5,0),"""")"
Next cell
' 結果が0の場合は空白にするために数式を値に変換
' 数式を値に変換する
destSheet.Range("O8:O" & lastRowDest).Value = destSheet.Range("O8:O" & lastRowDest).Value
destSheet.Range("Q8:Q" & lastRowDest).Value = destSheet.Range("Q8:Q" & lastRowDest).Value
'''''''''''''''''''''''''''''''''''''''''
''''''''以下ディズニー1の処置''''''
' 貼付シートのD列の最終行を取得
lastRowDest = destSheet.Cells(destSheet.Rows.Count, "R").End(xlUp).Row
' CSR集計シートのB列の最終行を取得
lastRowSrc = srcSheet.Cells(srcSheet.Rows.Count, "B").End(xlUp).Row
' 貼付シートのD列を範囲として取得
Set destRange = destSheet.Range("R8:R" & lastRowDest)
' H列にVLOOKUP関数を適用
For Each cell In destRange
cell.Offset(0, 4).Formula = "=IFERROR(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",6,0),"""")"
Next cell
' J列にVLOOKUP関数を適用
For Each cell In destRange
cell.Offset(0, 6).Formula = "=IFERROR(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",7,0),"""")"
Next cell
' Z列にVLOOKUP関数を適用
For Each cell In destRange
cell.Offset(0, 8).Formula = "=IFERROR(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",8,0),"""")"
Next cell
' 結果が0の場合は空白にするために数式を値に変換
' 数式を値に変換する
destSheet.Range("V8:V" & lastRowDest).Value = destSheet.Range("V8:V" & lastRowDest).Value
destSheet.Range("X8:X" & lastRowDest).Value = destSheet.Range("X8:X" & lastRowDest).Value
destSheet.Range("Z8:Z" & lastRowDest).Value = destSheet.Range("Z8:Z" & lastRowDest).Value
'''''''''''''''''''''''''''''''''''''''''
''''''''以下ディズニー2の処置''''''
' 貼付シートのD列の最終行を取得
lastRowDest = destSheet.Cells(destSheet.Rows.Count, "AA").End(xlUp).Row
' CSR集計シートのB列の最終行を取得
lastRowSrc = srcSheet.Cells(srcSheet.Rows.Count, "B").End(xlUp).Row
' 貼付シートのD列を範囲として取得
Set destRange = destSheet.Range("AA8:AA" & lastRowDest)
' H列にVLOOKUP関数を適用
For Each cell In destRange
cell.Offset(0, 4).Formula = "=IFERROR(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",6,0),"""")"
Next cell
' J列にVLOOKUP関数を適用
For Each cell In destRange
cell.Offset(0, 6).Formula = "=IFERROR(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",7,0),"""")"
Next cell
' Z列にVLOOKUP関数を適用
For Each cell In destRange
cell.Offset(0, 8).Formula = "=IFERROR(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",8,0),"""")"
Next cell
' 結果が0の場合は空白にするために数式を値に変換
' 数式を値に変換する
destSheet.Range("AE8:AE" & lastRowDest).Value = destSheet.Range("AE8:AE" & lastRowDest).Value
destSheet.Range("AG8:AG" & lastRowDest).Value = destSheet.Range("AG8:AG" & lastRowDest).Value
destSheet.Range("AI8:AI" & lastRowDest).Value = destSheet.Range("AI8:AI" & lastRowDest).Value
'''''''''''''''''''''''''''''''''''''''''
''''''''以下NHK処置''''''
' 貼付シートのD列の最終行を取得
lastRowDest = destSheet.Cells(destSheet.Rows.Count, "AJ").End(xlUp).Row
' CSR集計シートのB列の最終行を取得
lastRowSrc = srcSheet.Cells(srcSheet.Rows.Count, "B").End(xlUp).Row
' 貼付シートのD列を範囲として取得
Set destRange = destSheet.Range("AJ8:AJ" & lastRowDest)
' H列にVLOOKUP関数を適用
For Each cell In destRange
cell.Offset(0, 4).Formula = "=IFERROR(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",9,0),"""")"
Next cell
' J列にVLOOKUP関数を適用
For Each cell In destRange
cell.Offset(0, 6).Formula = "=IFERROR(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",10,0),"""")"
Next cell
' 結果が0の場合は空白にするために数式を値に変換
' 数式を値に変換する
destSheet.Range("AN8:AN" & lastRowDest).Value = destSheet.Range("AN8:AN" & lastRowDest).Value
destSheet.Range("AP8:AP" & lastRowDest).Value = destSheet.Range("AP8:AP" & lastRowDest).Value
'''''''''''''''''''''''''''''''''''''''''
''''''''以下AU処置''''''
lastRowDest = destSheet.Cells(destSheet.Rows.Count, "AQ").End(xlUp).Row
lastRowSrc = srcSheet.Cells(srcSheet.Rows.Count, "B").End(xlUp).Row
Set destRange = destSheet.Range("AQ8:AQ" & lastRowDest)
For Each cell In destRange
cell.Offset(0, 4).Formula = "=IFERROR(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",11,0),"""")"
Next cell
For Each cell In destRange
cell.Offset(0, 6).Formula = "=IFERROR(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",12,0),"""")"
Next cell
destSheet.Range("AU8:AU" & lastRowDest).Value = destSheet.Range("AU8:AU" & lastRowDest).Value
destSheet.Range("AW8:AW" & lastRowDest).Value = destSheet.Range("AW8:AW" & lastRowDest).Value
'''''''''''''''''''''''''''''''''''''''''
''''''''以下誘導1処置''''''
lastRowDest = destSheet.Cells(destSheet.Rows.Count, "DJ").End(xlUp).Row
lastRowSrc = srcSheet.Cells(srcSheet.Rows.Count, "B").End(xlUp).Row
Set destRange = destSheet.Range("DJ8:DJ" & lastRowDest)
For Each cell In destRange
cell.Offset(0, 4).Formula = "=IFERROR(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",13,0),"""")"
Next cell
For Each cell In destRange
cell.Offset(0, 6).Formula = "=IFERROR(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",14,0),"""")"
Next cell
destSheet.Range("DN8:DN" & lastRowDest).Value = destSheet.Range("DN8:DN" & lastRowDest).Value
destSheet.Range("DP8:DP" & lastRowDest).Value = destSheet.Range("DP8:DP" & lastRowDest).Value
'''''''''''''''''''''''''''''''''''''''''
''''''''以下誘導2処置''''''
lastRowDest = destSheet.Cells(destSheet.Rows.Count, "DQ").End(xlUp).Row
lastRowSrc = srcSheet.Cells(srcSheet.Rows.Count, "B").End(xlUp).Row
Set destRange = destSheet.Range("DQ8:DQ" & lastRowDest)
For Each cell In destRange
cell.Offset(0, 4).Formula = "=IFERROR(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",13,0),"""")"
Next cell
For Each cell In destRange
cell.Offset(0, 6).Formula = "=IFERROR(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",14,0),"""")"
Next cell
destSheet.Range("DU8:DU" & lastRowDest).Value = destSheet.Range("DU8:DU" & lastRowDest).Value
destSheet.Range("DW8:DW" & lastRowDest).Value = destSheet.Range("DW8:DW" & lastRowDest).Value
'''''''''''''''''''''''''''''''''''''''''
''''''''以下誘導3処置''''''
lastRowDest = destSheet.Cells(destSheet.Rows.Count, "DX").End(xlUp).Row
lastRowSrc = srcSheet.Cells(srcSheet.Rows.Count, "B").End(xlUp).Row
Set destRange = destSheet.Range("DX8:DX" & lastRowDest)
For Each cell In destRange
cell.Offset(0, 4).Formula = "=IFERROR(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",13,0),"""")"
Next cell
For Each cell In destRange
cell.Offset(0, 6).Formula = "=IFERROR(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",14,0),"""")"
Next cell
destSheet.Range("EB8:EB" & lastRowDest).Value = destSheet.Range("EB8:EB" & lastRowDest).Value
destSheet.Range("ED8:ED" & lastRowDest).Value = destSheet.Range("ED8:ED" & lastRowDest).Value
End Sub