[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『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:47
条件判定も転記も、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.