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(IF(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",2,0)<>0,VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",2,0),""""),"""")"
Next cell
' J列にVLOOKUP関数を適用
For Each cell In destRange
cell.Offset(0, 6).Formula = "=IFERROR(IF(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",3,0)<>0,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(IF(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",4,0)<>0,VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",4,0),""""),"""")"
Next cell
' J列にVLOOKUP関数を適用
For Each cell In destRange
cell.Offset(0, 6).Formula = "=IFERROR(IF(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",5,0)<>0,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(IF(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",6,0)<>0,VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",6,0),""""),"""")"
Next cell
' J列にVLOOKUP関数を適用
For Each cell In destRange
cell.Offset(0, 6).Formula = "=IFERROR(IF(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",7,0)<>0,VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",7,0),""""),"""")"
Next cell
' Z列にVLOOKUP関数を適用
For Each cell In destRange
cell.Offset(0, 8).Formula = "=IFERROR(IF(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",8,0)<>0,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(IF(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",6,0)<>0,VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",6,0),""""),"""")"
Next cell
' J列にVLOOKUP関数を適用
For Each cell In destRange
cell.Offset(0, 6).Formula = "=IFERROR(IF(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",7,0)<>0,VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",7,0),""""),"""")"
Next cell
' Z列にVLOOKUP関数を適用
For Each cell In destRange
cell.Offset(0, 8).Formula = "=IFERROR(IF(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",8,0)<>0,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(IF(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",9,0)<>0,VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",9,0),""""),"""")"
Next cell
' J列にVLOOKUP関数を適用
For Each cell In destRange
cell.Offset(0, 6).Formula = "=IFERROR(IF(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",10,0)<>0,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(IF(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",11,0)<>0,VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",11,0),""""),"""")"
Next cell
For Each cell In destRange
cell.Offset(0, 6).Formula = "=IFERROR(IF(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",12,0)<>0,VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",12,0),""""),"""")"
Next cell
destSheet.Range("AU8:AU" & lastRowDest).Value = destSheet.Range("AU8:AUI" & lastRowDest).Value
destSheet.Range("AW8:AW" & lastRowDest).Value = destSheet.Range("AW8:AW" & lastRowDest).Value
'''''''''''''''''''''''''''''''''''''''''
''''''''以下誘導1処置''''''
lastRowDest = destSheet.Cells(destSheet.rows.Count, "AX").End(xlUp).Row
lastRowSrc = srcSheet.Cells(srcSheet.rows.Count, "B").End(xlUp).Row
Set destRange = destSheet.Range("AX8:AX" & lastRowDest)
For Each cell In destRange
cell.Offset(0, 4).Formula = "=IFERROR(IF(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",11,0)<>0,VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",13,0),""""),"""")"
Next cell
For Each cell In destRange
cell.Offset(0, 6).Formula = "=IFERROR(IF(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",12,0)<>0,VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",14,0),""""),"""")"
Next cell
destSheet.Range("BB8:BB" & lastRowDest).Value = destSheet.Range("BB8:BBI" & lastRowDest).Value
destSheet.Range("BD8:BD" & lastRowDest).Value = destSheet.Range("BD8:BD" & lastRowDest).Value
'''''''''''''''''''''''''''''''''''''''''
''''''''以下誘導2処置''''''
lastRowDest = destSheet.Cells(destSheet.rows.Count, "BE").End(xlUp).Row
lastRowSrc = srcSheet.Cells(srcSheet.rows.Count, "B").End(xlUp).Row
Set destRange = destSheet.Range("BE8:BE" & lastRowDest)
For Each cell In destRange
cell.Offset(0, 4).Formula = "=IFERROR(IF(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",11,0)<>0,VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",13,0),""""),"""")"
Next cell
For Each cell In destRange
cell.Offset(0, 6).Formula = "=IFERROR(IF(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",12,0)<>0,VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",14,0),""""),"""")"
Next cell
destSheet.Range("BI8:BI" & lastRowDest).Value = destSheet.Range("BI8:BII" & lastRowDest).Value
destSheet.Range("BK8:BK" & lastRowDest).Value = destSheet.Range("BK8:BK" & lastRowDest).Value
'''''''''''''''''''''''''''''''''''''''''
''''''''以下誘導3処置''''''
lastRowDest = destSheet.Cells(destSheet.rows.Count, "BL").End(xlUp).Row
lastRowSrc = srcSheet.Cells(srcSheet.rows.Count, "B").End(xlUp).Row
Set destRange = destSheet.Range("BL8:BL" & lastRowDest)
For Each cell In destRange
cell.Offset(0, 4).Formula = "=IFERROR(IF(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",11,0)<>0,VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",13,0),""""),"""")"
Next cell
For Each cell In destRange
cell.Offset(0, 6).Formula = "=IFERROR(IF(VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",12,0)<>0,VLOOKUP(" & cell.Address & ",CSR集計!B2:AA" & lastRowSrc & ",14,0),""""),"""")"
Next cell
destSheet.Range("BP8:BP" & lastRowDest).Value = destSheet.Range("BP8:BPI" & lastRowDest).Value
destSheet.Range("BR8:BR" & lastRowDest).Value = destSheet.Range("BR8:BR" & lastRowDest).Value
End Sub