[[20211126185107]] 『VBAで別シートに高速で転記したい』(たんご) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『VBAで別シートに高速で転記したい』(たんご)

ws0のデータを条件によってループ1→ループ2の順番で
それぞれws1〜3に転記したいです。

[ループ1]
■条件1:ws0のBJが"営業無_義務無"
■条件2:ws0のBK列が空欄
■条件3:ws0のG列が"表1対応" → ws1の最終行+1行のAセルに、ws0のA〜Z列・AB・AD・AF・AH・AJ・AN・AO・AP・AQ・AR・AS・AY・AZ・BA〜BCを貼付け、ws1のAP列に日付転記
     ws0のG列が"表2対応" → ws2の最終行+1行のAセルに、ws0のA〜Z列・AB・AD・AF・AH・AJ・AN・AO・AP・AQ・AR・AS・AY・AZ・BA〜BCを貼付け、ws2のAL列に日付転記
     ws0のG列が"表3対応" → ws3の最終行+1行のAセルに、ws0のA〜Z列・AB・AD・AF・AH・AJ・AN・AO・AP・AQ・AR・AS・AY・AZ・BA〜BCを貼付け、ws3のAL列に日付転記

[ループ2]
■条件1:ws0のBJが"営業有_義務無"
■条件2:ws0のBK列が空欄
■条件3:ws0のG列が"表1対応" → ws1の最終行+1行のAセルに、ws0のA〜Z列・AB・AD・AF・AH・AJ・AN・AO・AP・AQ・AR・AS・AY・AZ・BA〜BCを貼付け、ws1のAO列に"義務追加"、AP列に日付転記
     ws0のG列が"表2対応" → ws2の最終行+1行のAセルに、ws0のA〜Z列・AB・AD・AF・AH・AJ・AN・AO・AP・AQ・AR・AS・AY・AZ・BA〜BCを貼付け、ws2のAK列に"義務追加"、AL列に日付転記
     ws0のG列が"表3対応" → ws3の最終行+1行のAセルに、ws0のA〜Z列・AB・AD・AF・AH・AJ・AN・AO・AP・AQ・AR・AS・AY・AZ・BA〜BCを貼付け、ws3のAK列に"義務追加"、Al列に日付転記

自分で↓のコードを書きました。
データ量が多いと5分以上かかるのと、可読性が悪いので直したいのですが、
知識がなく手詰まりです。
配列もよくわかっていない状態です。
お手数ですが、どのようにしたらよいかご教授ください。

  Dim Ct0 As Long
  Dim Maxrow0 As Long, Maxrow1 As Long, Maxrow2 As Long, Maxrow3 As Long, Model As String
  Dim ws0 As Worksheet, ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet

  Set ws0 = Sheets("表0")
  Set ws1 = Sheets("表1")
  Set ws2 = Sheets("表2")
  Set ws3 = Sheets("表3")

  Maxrow0 = ws0.Range("A" & Rows.Count).End(xlUp).Row
  Maxrow1 = ws1.Range("A" & Rows.Count).End(xlUp).Row
  Maxrow2 = ws2.Range("A" & Rows.Count).End(xlUp).Row
  Maxrow3 = ws3.Range("A" & Rows.Count).End(xlUp).Row

  Application.ScreenUpdating = False

  For Ct0 = 2 To Maxrow0
  If ws0.Range("BJ" & Ct0) = "営業無_義務無" Then
    If ws0.Range("BK" & Ct0) = "" Then
      Model = ws0.Range("G" & Ct0)
      Select Case True
        Case Model Like "*表1対応*"
          ws1.Range("A" & Maxrow1 + 1) = ws0.Range("A" & Ct0)
          ws1.Range("B" & Maxrow1 + 1) = ws0.Range("B" & Ct0)
          ws1.Range("C" & Maxrow1 + 1) = ws0.Range("C" & Ct0)
          ws1.Range("D" & Maxrow1 + 1) = ws0.Range("D" & Ct0)
          ws1.Range("E" & Maxrow1 + 1) = ws0.Range("E" & Ct0)
          ws1.Range("F" & Maxrow1 + 1) = ws0.Range("F" & Ct0)
          ws1.Range("G" & Maxrow1 + 1) = ws0.Range("G" & Ct0)
          ws1.Range("H" & Maxrow1 + 1) = ws0.Range("H" & Ct0)
          ws1.Range("I" & Maxrow1 + 1) = ws0.Range("I" & Ct0)
          ws1.Range("J" & Maxrow1 + 1) = ws0.Range("J" & Ct0)
          ws1.Range("K" & Maxrow1 + 1) = ws0.Range("K" & Ct0)
          ws1.Range("L" & Maxrow1 + 1) = ws0.Range("L" & Ct0)
          ws1.Range("M" & Maxrow1 + 1) = ws0.Range("M" & Ct0)
          ws1.Range("N" & Maxrow1 + 1) = ws0.Range("P" & Ct0)
          ws1.Range("O" & Maxrow1 + 1) = ws0.Range("R" & Ct0)
          ws1.Range("P" & Maxrow1 + 1) = ws0.Range("S" & Ct0)
          ws1.Range("Q" & Maxrow1 + 1) = ws0.Range("U" & Ct0)
          ws1.Range("R" & Maxrow1 + 1) = ws0.Range("V" & Ct0)
          ws1.Range("S" & Maxrow1 + 1) = ws0.Range("X" & Ct0)
          ws1.Range("T" & Maxrow1 + 1) = ws0.Range("Z" & Ct0)
          ws1.Range("U" & Maxrow1 + 1) = ws0.Range("AB" & Ct0)
          ws1.Range("V" & Maxrow1 + 1) = ws0.Range("AD" & Ct0)
          ws1.Range("W" & Maxrow1 + 1) = ws0.Range("AF" & Ct0)
          ws1.Range("X" & Maxrow1 + 1) = ws0.Range("AH" & Ct0)
          ws1.Range("Y" & Maxrow1 + 1) = ws0.Range("AJ" & Ct0)
          ws1.Range("Z" & Maxrow1 + 1) = ws0.Range("AN" & Ct0)
          ws1.Range("AA" & Maxrow1 + 1) = ws0.Range("AO" & Ct0)
          ws1.Range("AB" & Maxrow1 + 1) = ws0.Range("AP" & Ct0)
          ws1.Range("AC" & Maxrow1 + 1) = ws0.Range("AQ" & Ct0)
          ws1.Range("AD" & Maxrow1 + 1) = ws0.Range("AR" & Ct0)
          ws1.Range("AE" & Maxrow1 + 1) = ws0.Range("AS" & Ct0)
          ws1.Range("AF" & Maxrow1 + 1) = ws0.Range("AY" & Ct0)
          ws1.Range("AG" & Maxrow1 + 1) = ws0.Range("AZ" & Ct0)
          ws1.Range("AH" & Maxrow1 + 1) = ws0.Range("BA" & Ct0)
          ws1.Range("AI" & Maxrow1 + 1) = ws0.Range("BB" & Ct0)
          ws1.Range("AJ" & Maxrow1 + 1) = ws0.Range("BC" & Ct0)
          ws1.Range("AP" & Maxrow1 + 1) = Date
          Maxrow1 = Maxrow1 + 1
'------------------------------------------------------------------------------------
        Case Model Like "*表2対応*"
          ws2.Range("A" & Maxrow2 + 1) = ws0.Range("A" & Ct0)
          ws2.Range("B" & Maxrow2 + 1) = ws0.Range("B" & Ct0)
          ws2.Range("C" & Maxrow2 + 1) = ws0.Range("C" & Ct0)
          ws2.Range("D" & Maxrow2 + 1) = ws0.Range("D" & Ct0)
          ws2.Range("E" & Maxrow2 + 1) = ws0.Range("E" & Ct0)
          ws2.Range("F" & Maxrow2 + 1) = ws0.Range("F" & Ct0)
          ws2.Range("G" & Maxrow2 + 1) = ws0.Range("G" & Ct0)
          ws2.Range("H" & Maxrow2 + 1) = ws0.Range("H" & Ct0)
          ws2.Range("I" & Maxrow2 + 1) = ws0.Range("I" & Ct0)
          ws2.Range("J" & Maxrow2 + 1) = ws0.Range("J" & Ct0)
          ws2.Range("K" & Maxrow2 + 1) = ws0.Range("K" & Ct0)
          ws2.Range("L" & Maxrow2 + 1) = ws0.Range("L" & Ct0)
          ws2.Range("M" & Maxrow2 + 1) = ws0.Range("M" & Ct0)
          ws2.Range("N" & Maxrow2 + 1) = ws0.Range("P" & Ct0)
          ws2.Range("O" & Maxrow2 + 1) = ws0.Range("R" & Ct0)
          ws2.Range("P" & Maxrow2 + 1) = ws0.Range("S" & Ct0)
          ws2.Range("Q" & Maxrow2 + 1) = ws0.Range("U" & Ct0)
          ws2.Range("R" & Maxrow2 + 1) = ws0.Range("V" & Ct0)
          ws2.Range("S" & Maxrow2 + 1) = ws0.Range("X" & Ct0)
          ws2.Range("T" & Maxrow2 + 1) = ws0.Range("Z" & Ct0)
          ws2.Range("U" & Maxrow2 + 1) = ws0.Range("AB" & Ct0)
          ws2.Range("V" & Maxrow2 + 1) = ws0.Range("AD" & Ct0)
          ws2.Range("W" & Maxrow2 + 1) = ws0.Range("AF" & Ct0)
          ws2.Range("X" & Maxrow2 + 1) = ws0.Range("AH" & Ct0)
          ws2.Range("Y" & Maxrow2 + 1) = ws0.Range("AJ" & Ct0)
          ws2.Range("Z" & Maxrow2 + 1) = ws0.Range("AN" & Ct0)
          ws2.Range("AA" & Maxrow2 + 1) = ws0.Range("AO" & Ct0)
          ws2.Range("AB" & Maxrow2 + 1) = ws0.Range("AP" & Ct0)
          ws2.Range("AC" & Maxrow2 + 1) = ws0.Range("AQ" & Ct0)
          ws2.Range("AD" & Maxrow2 + 1) = ws0.Range("AR" & Ct0)
          ws2.Range("AE" & Maxrow2 + 1) = ws0.Range("AS" & Ct0)
          ws2.Range("AF" & Maxrow2 + 1) = ws0.Range("AY" & Ct0)
          ws2.Range("AG" & Maxrow2 + 1) = ws0.Range("AZ" & Ct0)
          ws2.Range("AH" & Maxrow2 + 1) = ws0.Range("BA" & Ct0)
          ws2.Range("AI" & Maxrow2 + 1) = ws0.Range("BB" & Ct0)
          ws2.Range("AJ" & Maxrow2 + 1) = ws0.Range("BC" & Ct0)
          ws2.Range("AL" & Maxrow2 + 1) = Date
          Maxrow2 = Maxrow2 + 1
'------------------------------------------------------------------------------------
        Case Model Like "*表3対応*"
          ws3.Range("A" & Maxrow3 + 1) = ws0.Range("A" & Ct0)
          ws3.Range("B" & Maxrow3 + 1) = ws0.Range("B" & Ct0)
          ws3.Range("C" & Maxrow3 + 1) = ws0.Range("C" & Ct0)
          ws3.Range("D" & Maxrow3 + 1) = ws0.Range("D" & Ct0)
          ws3.Range("E" & Maxrow3 + 1) = ws0.Range("E" & Ct0)
          ws3.Range("F" & Maxrow3 + 1) = ws0.Range("F" & Ct0)
          ws3.Range("G" & Maxrow3 + 1) = ws0.Range("G" & Ct0)
          ws3.Range("H" & Maxrow3 + 1) = ws0.Range("H" & Ct0)
          ws3.Range("I" & Maxrow3 + 1) = ws0.Range("I" & Ct0)
          ws3.Range("J" & Maxrow3 + 1) = ws0.Range("J" & Ct0)
          ws3.Range("K" & Maxrow3 + 1) = ws0.Range("K" & Ct0)
          ws3.Range("L" & Maxrow3 + 1) = ws0.Range("L" & Ct0)
          ws3.Range("M" & Maxrow3 + 1) = ws0.Range("M" & Ct0)
          ws3.Range("N" & Maxrow3 + 1) = ws0.Range("P" & Ct0)
          ws3.Range("O" & Maxrow3 + 1) = ws0.Range("R" & Ct0)
          ws3.Range("P" & Maxrow3 + 1) = ws0.Range("S" & Ct0)
          ws3.Range("Q" & Maxrow3 + 1) = ws0.Range("U" & Ct0)
          ws3.Range("R" & Maxrow3 + 1) = ws0.Range("V" & Ct0)
          ws3.Range("S" & Maxrow3 + 1) = ws0.Range("X" & Ct0)
          ws3.Range("T" & Maxrow3 + 1) = ws0.Range("Z" & Ct0)
          ws3.Range("U" & Maxrow3 + 1) = ws0.Range("AB" & Ct0)
          ws3.Range("V" & Maxrow3 + 1) = ws0.Range("AD" & Ct0)
          ws3.Range("W" & Maxrow3 + 1) = ws0.Range("AF" & Ct0)
          ws3.Range("X" & Maxrow3 + 1) = ws0.Range("AH" & Ct0)
          ws3.Range("Y" & Maxrow3 + 1) = ws0.Range("AJ" & Ct0)
          ws3.Range("Z" & Maxrow3 + 1) = ws0.Range("AN" & Ct0)
          ws2.Range("AA" & Maxrow3 + 1) = ws0.Range("AO" & Ct0)
          ws2.Range("AB" & Maxrow3 + 1) = ws0.Range("AP" & Ct0)
          ws2.Range("AC" & Maxrow3 + 1) = ws0.Range("AQ" & Ct0)
          ws2.Range("AD" & Maxrow3 + 1) = ws0.Range("AR" & Ct0)
          ws2.Range("AE" & Maxrow3 + 1) = ws0.Range("AS" & Ct0)
          ws2.Range("AF" & Maxrowv + 1) = ws0.Range("AY" & Ct0)
          ws2.Range("AG" & Maxrow3 + 1) = ws0.Range("AZ" & Ct0)
          ws2.Range("AH" & Maxrow3 + 1) = ws0.Range("BA" & Ct0)
          ws2.Range("AI" & Maxrow3 + 1) = ws0.Range("BB" & Ct0)
          ws2.Range("AJ" & Maxrow3 + 1) = ws0.Range("BC" & Ct0)
          ws2.Range("AL" & Maxrow3 + 1) = Date
          Maxrow3 = Maxrow3 + 1
        Case Else
      End Select
    End If
  End If
  Next Ct0

  For Ct0 = 2 To Maxrow0
  If ws0.Range("BJ" & Ct0) = "営業有_義務無" Then
    If ws0.Range("BK" & Ct0) = "" Then
      Model = ws0.Range("G" & Ct0)
      Select Case True
        Case Model Like "*表1対応*"
          ws1.Range("A" & Maxrow1 + 1) = ws0.Range("A" & Ct0)
          ws1.Range("B" & Maxrow1 + 1) = ws0.Range("B" & Ct0)
          ws1.Range("C" & Maxrow1 + 1) = ws0.Range("C" & Ct0)
          ws1.Range("D" & Maxrow1 + 1) = ws0.Range("D" & Ct0)
          ws1.Range("E" & Maxrow1 + 1) = ws0.Range("E" & Ct0)
          ws1.Range("F" & Maxrow1 + 1) = ws0.Range("F" & Ct0)
          ws1.Range("G" & Maxrow1 + 1) = ws0.Range("G" & Ct0)
          ws1.Range("H" & Maxrow1 + 1) = ws0.Range("H" & Ct0)
          ws1.Range("I" & Maxrow1 + 1) = ws0.Range("I" & Ct0)
          ws1.Range("J" & Maxrow1 + 1) = ws0.Range("J" & Ct0)
          ws1.Range("K" & Maxrow1 + 1) = ws0.Range("K" & Ct0)
          ws1.Range("L" & Maxrow1 + 1) = ws0.Range("L" & Ct0)
          ws1.Range("M" & Maxrow1 + 1) = ws0.Range("M" & Ct0)
          ws1.Range("N" & Maxrow1 + 1) = ws0.Range("P" & Ct0)
          ws1.Range("O" & Maxrow1 + 1) = ws0.Range("R" & Ct0)
          ws1.Range("P" & Maxrow1 + 1) = ws0.Range("S" & Ct0)
          ws1.Range("Q" & Maxrow1 + 1) = ws0.Range("U" & Ct0)
          ws1.Range("R" & Maxrow1 + 1) = ws0.Range("V" & Ct0)
          ws1.Range("S" & Maxrow1 + 1) = ws0.Range("X" & Ct0)
          ws1.Range("T" & Maxrow1 + 1) = ws0.Range("Z" & Ct0)
          ws1.Range("U" & Maxrow1 + 1) = ws0.Range("AB" & Ct0)
          ws1.Range("V" & Maxrow1 + 1) = ws0.Range("AD" & Ct0)
          ws1.Range("W" & Maxrow1 + 1) = ws0.Range("AF" & Ct0)
          ws1.Range("X" & Maxrow1 + 1) = ws0.Range("AH" & Ct0)
          ws1.Range("Y" & Maxrow1 + 1) = ws0.Range("AJ" & Ct0)
          ws1.Range("Z" & Maxrow1 + 1) = ws0.Range("AN" & Ct0)
          ws1.Range("AA" & Maxrow1 + 1) = ws0.Range("AO" & Ct0)
          ws1.Range("AB" & Maxrow1 + 1) = ws0.Range("AP" & Ct0)
          ws1.Range("AC" & Maxrow1 + 1) = ws0.Range("AQ" & Ct0)
          ws1.Range("AD" & Maxrow1 + 1) = ws0.Range("AR" & Ct0)
          ws1.Range("AE" & Maxrow1 + 1) = ws0.Range("AS" & Ct0)
          ws1.Range("AF" & Maxrow1 + 1) = ws0.Range("AY" & Ct0)
          ws1.Range("AG" & Maxrow1 + 1) = ws0.Range("AZ" & Ct0)
          ws1.Range("AH" & Maxrow1 + 1) = ws0.Range("BA" & Ct0)
          ws1.Range("AI" & Maxrow1 + 1) = ws0.Range("BB" & Ct0)
          ws1.Range("AJ" & Maxrow1 + 1) = ws0.Range("BC" & Ct0)
          ws1.Range("AO" & Maxrow1 + 1) = "義務追加"
          ws1.Range("AP" & Maxrow1 + 1) = Date
          Maxrow1 = Maxrow1 + 1
'------------------------------------------------------------------------------------
        Case Model Like "*表2対応*"
          ws2.Range("A" & Maxrow2 + 1) = ws0.Range("A" & Ct0)
          ws2.Range("B" & Maxrow2 + 1) = ws0.Range("B" & Ct0)
          ws2.Range("C" & Maxrow2 + 1) = ws0.Range("C" & Ct0)
          ws2.Range("D" & Maxrow2 + 1) = ws0.Range("D" & Ct0)
          ws2.Range("E" & Maxrow2 + 1) = ws0.Range("E" & Ct0)
          ws2.Range("F" & Maxrow2 + 1) = ws0.Range("F" & Ct0)
          ws2.Range("G" & Maxrow2 + 1) = ws0.Range("G" & Ct0)
          ws2.Range("H" & Maxrow2 + 1) = ws0.Range("H" & Ct0)
          ws2.Range("I" & Maxrow2 + 1) = ws0.Range("I" & Ct0)
          ws2.Range("J" & Maxrow2 + 1) = ws0.Range("J" & Ct0)
          ws2.Range("K" & Maxrow2 + 1) = ws0.Range("K" & Ct0)
          ws2.Range("L" & Maxrow2 + 1) = ws0.Range("L" & Ct0)
          ws2.Range("M" & Maxrow2 + 1) = ws0.Range("M" & Ct0)
          ws2.Range("N" & Maxrow2 + 1) = ws0.Range("P" & Ct0)
          ws2.Range("O" & Maxrow2 + 1) = ws0.Range("R" & Ct0)
          ws2.Range("P" & Maxrow2 + 1) = ws0.Range("S" & Ct0)
          ws2.Range("Q" & Maxrow2 + 1) = ws0.Range("U" & Ct0)
          ws2.Range("R" & Maxrow2 + 1) = ws0.Range("V" & Ct0)
          ws2.Range("S" & Maxrow2 + 1) = ws0.Range("X" & Ct0)
          ws2.Range("T" & Maxrow2 + 1) = ws0.Range("Z" & Ct0)
          ws2.Range("U" & Maxrow2 + 1) = ws0.Range("AB" & Ct0)
          ws2.Range("V" & Maxrow2 + 1) = ws0.Range("AD" & Ct0)
          ws2.Range("W" & Maxrow2 + 1) = ws0.Range("AF" & Ct0)
          ws2.Range("X" & Maxrow2 + 1) = ws0.Range("AH" & Ct0)
          ws2.Range("Y" & Maxrow2 + 1) = ws0.Range("AJ" & Ct0)
          ws2.Range("Z" & Maxrow2 + 1) = ws0.Range("AN" & Ct0)
          ws2.Range("AA" & Maxrow2 + 1) = ws0.Range("AO" & Ct0)
          ws2.Range("AB" & Maxrow2 + 1) = ws0.Range("AP" & Ct0)
          ws2.Range("AC" & Maxrow2 + 1) = ws0.Range("AQ" & Ct0)
          ws2.Range("AD" & Maxrow2 + 1) = ws0.Range("AR" & Ct0)
          ws2.Range("AE" & Maxrow2 + 1) = ws0.Range("AS" & Ct0)
          ws2.Range("AF" & Maxrow2 + 1) = ws0.Range("AY" & Ct0)
          ws2.Range("AG" & Maxrow2 + 1) = ws0.Range("AZ" & Ct0)
          ws2.Range("AH" & Maxrow2 + 1) = ws0.Range("BA" & Ct0)
          ws2.Range("AI" & Maxrow2 + 1) = ws0.Range("BB" & Ct0)
          ws2.Range("AJ" & Maxrow2 + 1) = ws0.Range("BC" & Ct0)
          ws2.Range("AK" & Maxrow2 + 1) = "義務追加"
          ws2.Range("AL" & Maxrow2 + 1) = Date
          Maxrow2 = Maxrow2 + 1
'------------------------------------------------------------------------------------
        Case Model Like "*表3対応*"
          ws3.Range("A" & Maxrow3 + 1) = ws0.Range("A" & Ct0)
          ws3.Range("B" & Maxrow3 + 1) = ws0.Range("B" & Ct0)
          ws3.Range("C" & Maxrow3 + 1) = ws0.Range("C" & Ct0)
          ws3.Range("D" & Maxrow3 + 1) = ws0.Range("D" & Ct0)
          ws3.Range("E" & Maxrow3 + 1) = ws0.Range("E" & Ct0)
          ws3.Range("F" & Maxrow3 + 1) = ws0.Range("F" & Ct0)
          ws3.Range("G" & Maxrow3 + 1) = ws0.Range("G" & Ct0)
          ws3.Range("H" & Maxrow3 + 1) = ws0.Range("H" & Ct0)
          ws3.Range("I" & Maxrow3 + 1) = ws0.Range("I" & Ct0)
          ws3.Range("J" & Maxrow3 + 1) = ws0.Range("J" & Ct0)
          ws3.Range("K" & Maxrow3 + 1) = ws0.Range("K" & Ct0)
          ws3.Range("L" & Maxrow3 + 1) = ws0.Range("L" & Ct0)
          ws3.Range("M" & Maxrow3 + 1) = ws0.Range("M" & Ct0)
          ws3.Range("N" & Maxrow3 + 1) = ws0.Range("P" & Ct0)
          ws3.Range("O" & Maxrow3 + 1) = ws0.Range("R" & Ct0)
          ws3.Range("P" & Maxrow3 + 1) = ws0.Range("S" & Ct0)
          ws3.Range("Q" & Maxrow3 + 1) = ws0.Range("U" & Ct0)
          ws3.Range("R" & Maxrow3 + 1) = ws0.Range("V" & Ct0)
          ws3.Range("S" & Maxrow3 + 1) = ws0.Range("X" & Ct0)
          ws3.Range("T" & Maxrow3 + 1) = ws0.Range("Z" & Ct0)
          ws3.Range("U" & Maxrow3 + 1) = ws0.Range("AB" & Ct0)
          ws3.Range("V" & Maxrow3 + 1) = ws0.Range("AD" & Ct0)
          ws3.Range("W" & Maxrow3 + 1) = ws0.Range("AF" & Ct0)
          ws3.Range("X" & Maxrow3 + 1) = ws0.Range("AH" & Ct0)
          ws3.Range("Y" & Maxrow3 + 1) = ws0.Range("AJ" & Ct0)
          ws3.Range("Z" & Maxrow3 + 1) = ws0.Range("AN" & Ct0)
          ws2.Range("AA" & Maxrow3 + 1) = ws0.Range("AO" & Ct0)
          ws2.Range("AB" & Maxrow3 + 1) = ws0.Range("AP" & Ct0)
          ws2.Range("AC" & Maxrow3 + 1) = ws0.Range("AQ" & Ct0)
          ws2.Range("AD" & Maxrow3 + 1) = ws0.Range("AR" & Ct0)
          ws2.Range("AE" & Maxrow3 + 1) = ws0.Range("AS" & Ct0)
          ws2.Range("AF" & Maxrowv + 1) = ws0.Range("AY" & Ct0)
          ws2.Range("AG" & Maxrow3 + 1) = ws0.Range("AZ" & Ct0)
          ws2.Range("AH" & Maxrow3 + 1) = ws0.Range("BA" & Ct0)
          ws2.Range("AI" & Maxrow3 + 1) = ws0.Range("BB" & Ct0)
          ws2.Range("AJ" & Maxrow3 + 1) = ws0.Range("BC" & Ct0)
          ws2.Range("AK" & Maxrow3 + 1) = "義務追加"
          ws2.Range("AL" & Maxrow3 + 1) = Date
        Case Else
      End Select
    End If
  End If
  Next Ct0

< 使用 Excel:Office365、使用 OS:Windows10 >


転記回数が多いので、フィルター機能を使って、
できるだけまとめて転記するようにしてはどうでしょうか

(マナ) 2021/11/26(金) 19:29


マナさん
返信ありがとうございます。
すみません、具体的にはどのようにしたらよいでしょうか。
(たんご) 2021/11/26(金) 19:39

「データ」タブにある「フィルター」機能を使ったことありますか。
マクロでも手作業と同じことができます。

(マナ) 2021/11/26(金) 19:47


マナさん
返信ありがとうございます。
フィルター機能は使用したことあります。
が、どのように使用したらよいか知識がなくわかりません。
お手数ですが教えていただけますか。
(たんご) 2021/11/26(金) 19:57

フィルター後、表全体をコピーして、どこでもよいので、貼り付けてみてください。
抽出された行のみがコピペできるはずです。

条件判定も転記も、1セルずつでなく、まとめてできるということです。

まずは手作業で、手順を確定させてください。
それを「マクロの記録」
記録されたコードを、ここに貼り付けてください。
ループ1 だけでよいです。

(マナ) 2021/11/26(金) 20:20


セル範囲 = 同サイズのセル範囲


Sheets("Sheet1").range("A1:Z1").value = Sheet("Sheet2").range("A3:Z3").value

とすれば、1個1個書き込むより格段に速くなります。
離れた所は、如何しようもないので1個1個で…。
(ボタンが有効) 2021/11/26(金) 21:31


横からですが私も参加で。

■1
見づらいので整理すると

Sheets("表0")のうちBJ列が"営業無_義務無"の場合、対応するシートに

 (1)A〜Z列・AB・AD・AF・AH・AJ・AN・AO・AP・AQ・AR・AS・AY・AZ・BA〜BCをA列から詰めてコピペ
 (2)G列が"表1対応"なら、対応するシートのAP列に日付記入
     〃  "表2対応"            〃        AL列に日付記入
     〃  "表3対応"            〃        AL列に日付記入

Sheets("表0")のうちBJ列が"営業有_義務無"の場合、対応するシートに

 (1)A〜Z列・AB・AD・AF・AH・AJ・AN・AO・AP・AQ・AR・AS・AY・AZ・BA〜BCをA列から詰めてコピペ
 (2)G列が"表1対応"なら、対応するシートのAP列に日付記入、AO列に"義務追加"と記入
     〃  "表2対応"            〃        AL列に日付記入、AK列に"義務追加"と記入
         "表3対応"            〃        AL列に日付記入、AK列に"義務追加"と記入

ということになりますかね。
そうであれば、パターンとしては3×2の6種類ですね

 G列が"表1対応"  BJ列が"営業無_義務無"
 G列が"表2対応"  BJ列が"営業無_義務無"
 G列が"表3対応"  BJ列が"営業無_義務無"

 G列が"表1対応"  BJ列が"営業有_義務無"
 G列が"表2対応"  BJ列が"営業有_義務無"
 G列が"表3対応"  BJ列が"営業有_義務無"

これであれば、そもそも論としてG列とBJ列をキーにして二重ループにすればよいですね。

■2
さらに、振り分ける条件が決まっているようなので、1行ずつ処理せず、既にアドバイスのあったように抽出を組み合わせることで簡略化できるとおもいます。

■3
ということを踏まえると↓のようにしてもよいのではないでしょうか?

    Sub 研究用()
        Dim 表 As Variant, 営業 As Variant
        Dim 抽出数 As Long
        Dim 出力行 As Long

        Stop 'ブレークポイントの代わり

        With Worksheets("表0")
            .AutoFilterMode = False
            .Rows(1).AutoFilter

            For Each 表 In Array("表1", "表2", "表3")
                For Each 営業 In Array("営業無_義務無", "営業有_義務無")
                    .AutoFilter.Range.AutoFilter Field:=7, Criteria1:=表 & "対応"
                    .AutoFilter.Range.AutoFilter Field:=62, Criteria1:=営業
                    .AutoFilter.Range.AutoFilter Field:=63, Criteria1:=""
                    抽出数 = Intersect(.AutoFilter.Range, .Columns(1)).SpecialCells(xlCellTypeVisible).Cells.Count - 1
                    If 抽出数 > 0 Then
                        出力行 = Worksheets(表).Cells(Rows.Count, "G").End(xlUp).Offset(1).Row

                        '▼共通の処理
                        Intersect(.AutoFilter.Range.Offset(1), Range("A1:M1,P1,R1:S1,U1:V1,X1,Z1,AB1,AD1,AF1,AH1,AJ1,AN1:AS1,AY1:BC1").EntireColumn).Copy Worksheets(表).Cells(出力行, "A")

                        '▼処理分岐する処理
                        Select Case 表
                            Case "表1"
                                Worksheets(表).Cells(出力行, "AP").Resize(抽出数).Value = Date
                                If 営業 = "営業有_義務無" Then
                                    Worksheets(表).Cells(出力行, "AO").Resize(抽出数).Value = "義務追加"
                                End If

                            Case "表2", "表3"
                                Worksheets(表).Cells(出力行, "AL").Resize(抽出数).Value = Date
                                If 営業 = "営業有_義務無" Then
                                    Worksheets(表).Cells(出力行, "AK").Resize(抽出数).Value = "義務追加"
                                End If
                        End Select
                    End If
                Next 営業
            Next 表
        End With

    End Sub

※1 上記は完成品のプレゼントを意図したものではありませんから、ステップ実行して研究のうえ必要な部分だけご自身のコードに組み込んでみてください

※2ステップ実行という言葉を聞いたことがなければ↓を読んでみてください。

 【ステップ実行】
https://www.239-programing.com/excel-vba/basic/basic023.html
http://plus1excel.web.fc2.com/learning/l301/t405.html

 【ブレークポイント】
https://www.239-programing.com/excel-vba/basic/basic022.html
https://www.tipsfound.com/vba/01010

また、以下も知っておいて損は無いと思います。

 【イミディエイトウィンドウ】
https://www.239-programing.com/excel-vba/basic/basic024.html
https://excel-ubara.com/excelvba1/EXCELVBA486.html

 【ローカルウィンドウ】
https://excel-ubara.com/excelvba4/EXCEL266.html
http://excelvba.pc-users.net/fol8/8_2.html

(もこな2) 2021/11/27(土) 14:11


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.