楽天からダウンロードした注文情報CSV(Sheet1)を
倉庫発送依頼CSVフォーマットに合うようSheet2に書き出すVBAコードを作りました。
以下の動作をするコードをご教示いただけますでしょうか?
Sheet1 AD列(Sheet2ではAB列にあたる)の数値が3000以上の行を探しそれぞれ行コピーし
その下にコピーした行を挿入、
Sheet2 挿入した行のAB列は0にし、
Sheet2 挿入した行のY列にはomake-01
Sheet2 挿入した行Z列にはおまけ、と書くようにする。
宜しくお願いします。
==============
SheetOption Explicit
Sub Main()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim row As Long
Dim idx As Integer
Dim ColNames
ColNames = Array("出荷指示NO", "店舗ID", "配送方法", "配達指定日", "配達時間帯", "代引有無", "配送先名称", "配送先郵便番号", "配送先都道府県", "配送先住所", "配送先電話番号", "送り状備考", "顧客注文日", "配送料金", "代引手数料金", "消費税率(8or10)", "消費税小計(8%)", "消費税小計(10%)", "消費税額", "ポイント使用額", "クーポン金額", "請求合計金額", "購入者名称", "ギフトフラグ", "商品ID", "商品名", "出荷予定数", "商品単価", "倉庫連絡事項")
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ws2 = ThisWorkbook.Worksheets("Sheet2")
'Sheet2のセルの書式および値を全てクリア
ws2.Cells.ClearContents
'セルの書式を「文字列」に設定
ws2.Cells.NumberFormat = "@"
'ヘッダーの設定
For idx = 0 To UBound(ColNames)
ws2.Cells(2, idx + 1).Value = ColNames(idx)
Next
'データをコピー
For row = 3 To ws1.Cells(Rows.Count, 1).End(xlUp).row
'Sheet2のA列←Sheet1のA列
ws2.Cells(row, 1).Value = ws1.Cells(row, 1).Value
'Sheet2のB列←"01"
ws2.Cells(row, 2).Value = "01"
'Sheet2のC列←Sheet1のB列
ws2.Cells(row, 3).Value = ws1.Cells(row, 2).Value
'Sheet2のD列←Sheet1のC列
If ws1.Cells(row, 3).Value = "0" Then
ws2.Cells(row, 4).Value = ""
Else
ws2.Cells(row, 4).Value = ws1.Cells(row, 3).Value
End If
ws2.Cells(row, 4).Value = Format(ws1.Cells(row, 3).Value, "yyyy/mm/dd")
'Sheet2のE列←Sheet1のD列
Select Case True
Case Len(ws1.Cells(row, 4).Value) = 4
ws2.Cells(row, 5).Value = Left(ws1.Cells(row, 4).Value, 2) & ":00~" & Right(ws1.Cells(row, 4).Value, 2) & ":00"
Case ws1.Cells(row, 4).Value = "0"
ws2.Cells(row, 5).Value = ""
Case ws1.Cells(row, 4).Value = "1"
ws2.Cells(row, 5).Value = "午前中"
End Select
'Sheet2のF列←Sheet1のE列
Select Case ws1.Cells(row, 5).Value
Case "クレジットカード"
ws2.Cells(row, 6).Value = "発払い"
Case "代引き"
ws2.Cells(row, 6).Value = "代引"
Case Else
ws2.Cells(row, 6).Value = ws1.Cells(row, 5).Value
End Select
'Sheet2のG列←Sheet1のF列、G列
ws2.Cells(row, 7).Value = ws1.Cells(row, 6).Value & ws1.Cells(row, 7).Value
'Sheet2のH列←Sheet1のH列、I列
ws2.Cells(row, 8).Value = ws1.Cells(row, 8).Value & ws1.Cells(row, 9).Value
'Sheet2のI列←Sheet1のJ列
ws2.Cells(row, 9).Value = ws1.Cells(row, 10).Value
'Sheet2のJ列←Sheet1のK列、L列
ws2.Cells(row, 10).Value = ws1.Cells(row, 11).Value & ws1.Cells(row, 12).Value
'Sheet2のK列←Sheet1のM列、N列、O列
ws2.Cells(row, 11).Value = ws1.Cells(row, 13).Value & ws1.Cells(row, 14).Value & ws1.Cells(row, 15).Value
'Sheet2のL列←Sheet1のP列
ws2.Cells(row, 12).Value = ws1.Cells(row, 16).Value
'Sheet2のM列←Sheet1のQ列
ws2.Cells(row, 13).Value = ws1.Cells(row, 17).Value
ws2.Cells(row, 13).Value = Format(ws1.Cells(row, 17).Value, "yyyy/mm/dd")
'Sheet2のN列←Sheet1のR列
ws2.Cells(row, 14).Value = ws1.Cells(row, 18).Value
'Sheet2のO列←Sheet1のS列
ws2.Cells(row, 15).Value = ws1.Cells(row, 19).Value
'Sheet2のP列←"10"
ws2.Cells(row, 16).Value = "10"
'Sheet2のR列←Sheet1のT列
ws2.Cells(row, 18).Value = ws1.Cells(row, 20).Value
'Sheet2のS列←Sheet1のT列
ws2.Cells(row, 19).Value = ws1.Cells(row, 20).Value
'Sheet2のT列←Sheet1のU列
ws2.Cells(row, 20).Value = ws1.Cells(row, 21).Value
'Sheet2のU列←Sheet1のV列
ws2.Cells(row, 21).Value = ws1.Cells(row, 22).Value
'Sheet2のV列←Sheet1のW列
ws2.Cells(row, 22).Value = ws1.Cells(row, 23).Value
'Sheet2のW列←Sheet1のX列、Y列
ws2.Cells(row, 23).Value = ws1.Cells(row, 24).Value & ws1.Cells(row, 25).Value
'Sheet2のX列←Sheet1のZ列
ws2.Cells(row, 24).Value = ws1.Cells(row, 26).Value
'Sheet2のY列←Sheet1のAA列
ws2.Cells(row, 25).Value = ws1.Cells(row, 27).Value
文字数の都合上 中略
'Sheet2のAC列←Sheet1のAE列
ws2.Cells(row, 29).Value = ws1.Cells(row, 31).Value
Next
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Set ws2 = Nothing
Set ws1 = Nothing
End Sub
No.1
- 回答日時:
コードが長いので全てを読んではいませんが、ご要望は要約すると
「AD列が3000を超える場合には下段に一行挿入しAB列は0にY列はomake-01、
Z列にはおまけを記載する」ということでしょうか
通常このような場合には内部カウンタと出力カウンタを分けて行うのが好ましいかと考えます。
そのため出力側(ws2)のrowとは別に変数を用意し、Forの前で初期値を設定(3)。
Next直前で加算(out=out+1)
同様にNext前にAD列の判定分を挿入し
'AD列3000以上
IF ws1.Cells(row, 30).Value>=3000 Then
out=out+1
ws2.Rows(out-1 & ":" & out-1).AutoFill Destination:=Rows(out-1 & ":" & out), Type:=xlFillCopy
'Yにomake-01
ws2.Cells(out, 23).Value="omake-01"
'Zにおまけ
ws2.Cells(out, 24).Value="おまけ"
'ABに0
ws2.Cells(out, 26).Value=0
End If
といった感じでいかがでしょうか
コピーの方法はいくつかあると思いますが、とりあえずフィルにて記載しています
ご参考までに
No.2
- 回答日時:
こんな感じはいかがですか?
①「 ← 追加」の行を追加して下さい
②「ws1.Cells(row」を「ws1.Cells(Srow」に置換
③「ws2.Cells(row」を「ws2.Cells(Drow」に置換
④「 ← 削除」の行を削除して下さい
※ 文字数制限が有るので元のコードを以下を参考に実行して下さい
Sub Main()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim row As Long ' ← 削除
Dim Srow As Long ' SourceRow ← 追加
Dim Drow As Long ' DestinationRow ← 追加
Dim idx As Integer
Dim ColNames
ColNames = Array("出荷指示NO", "店舗ID", "配送方法", "配達指定日", "配達時間帯", "代引有無", "配送先名称", "配送先郵便番号", "配送先都道府県", "配送先住所", "配送先電話番号", "送り状備考", "顧客注文日", "配送料金", "代引手数料金", "消費税率(8or10)", "消費税小計(8%)", "消費税小計(10%)", "消費税額", "ポイント使用額", "クーポン金額", "請求合計金額", "購入者名称", "ギフトフラグ", "商品ID", "商品名", "出荷予定数", "商品単価", "倉庫連絡事項")
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ws2 = ThisWorkbook.Worksheets("Sheet2")
'Sheet2のセルの書式および値を全てクリア
ws2.Cells.ClearContents
'セルの書式を「文字列」に設定
ws2.Cells.NumberFormat = "@"
'ヘッダーの設定
For idx = 0 To UBound(ColNames)
ws2.Cells(2, idx + 1).Value = ColNames(idx)
Next
'張付先行セット
Drow = 3 ← 追加
'データをコピー
For Srow = 3 To ws1.Cells(Srows.Count, 1).End(xlUp).row
'Sheet2のA列←Sheet1のA列
ws2.Cells(Drow, 1).Value = ws1.Cells(Srow, 1).Value
'Sheet2のB列←"01"
ws2.Cells(Drow, 2).Value = "01"
'Sheet2のC列←Sheet1のB列
ws2.Cells(Drow, 3).Value = ws1.Cells(Srow, 2).Value
'Sheet2のD列←Sheet1のC列
If ws1.Cells(Srow, 3).Value = "0" Then
ws2.Cells(Drow, 4).Value = ""
Else
ws2.Cells(Drow, 4).Value = ws1.Cells(Srow, 3).Value
End If
ws2.Cells(Drow, 4).Value = Format(ws1.Cells(Srow, 3).Value, "yyyy/mm/dd")
'Sheet2のE列←Sheet1のD列
Select Case True
Case Len(ws1.Cells(Srow, 4).Value) = 4
ws2.Cells(Drow, 5).Value = Left(ws1.Cells(Srow, 4).Value, 2) & ":00~" & Right(ws1.Cells(Srow, 4).Value, 2) & ":00"
Case ws1.Cells(Srow, 4).Value = "0"
ws2.Cells(Drow, 5).Value = ""
Case ws1.Cells(Srow, 4).Value = "1"
ws2.Cells(Drow, 5).Value = "午前中"
End Select
'Sheet2のF列←Sheet1のE列
Select Case ws1.Cells(Srow, 5).Value
Case "クレジットカード"
ws2.Cells(Drow, 6).Value = "発払い"
Case "代引き"
ws2.Cells(Drow, 6).Value = "代引"
Case Else
ws2.Cells(Drow, 6).Value = ws1.Cells(Srow, 5).Value
End Select
'Sheet2のG列←Sheet1のF列、G列
ws2.Cells(Drow, 7).Value = ws1.Cells(Srow, 6).Value & ws1.Cells(Srow, 7).Value
'Sheet2のH列←Sheet1のH列、I列
ws2.Cells(Drow, 8).Value = ws1.Cells(Srow, 8).Value & ws1.Cells(Srow, 9).Value
'Sheet2のI列←Sheet1のJ列
ws2.Cells(Drow, 9).Value = ws1.Cells(Srow, 10).Value
'Sheet2のJ列←Sheet1のK列、L列
ws2.Cells(Drow, 10).Value = ws1.Cells(Srow, 11).Value & ws1.Cells(Srow, 12).Value
'Sheet2のK列←Sheet1のM列、N列、O列
ws2.Cells(Drow, 11).Value = ws1.Cells(Srow, 13).Value & ws1.Cells(Srow, 14).Value & ws1.Cells(Srow, 15).Value
'Sheet2のL列←Sheet1のP列
ws2.Cells(Drow, 12).Value = ws1.Cells(Srow, 16).Value
'Sheet2のM列←Sheet1のQ列
ws2.Cells(Drow, 13).Value = ws1.Cells(Srow, 17).Value ' ←削除
ws2.Cells(Drow, 13).Value = Format(ws1.Cells(Srow, 17).Value, "yyyy/mm/dd")
'Sheet2のN列←Sheet1のR列
ws2.Cells(Drow, 14).Value = ws1.Cells(Srow, 18).Value
'Sheet2のO列←Sheet1のS列
ws2.Cells(Drow, 15).Value = ws1.Cells(Srow, 19).Value
'Sheet2のP列←"10"
ws2.Cells(Drow, 16).Value = "10"
'文字数の都合上 中略
'Sheet2のAC列←Sheet1のAE列
ws2.Cells(Drow, 29).Value = ws1.Cells(Srow, 31).Value
'AD列の数値が3000以上の処理
If ws1.Cells(Srow, 31).Value >= 3000 Then ' ← 追加
Drow = Drow + 1 ' ← 追加
ws2.Cells(Drow, 25).Value = "omake-01" ' ← 追加
ws2.Cells(Drow, 25).Value = "おまけ" ' ← 追加
ws2.Cells(Drow, 28).Value = 0 ' ← 追加
End If ' ← 追加
'張付先行セット
Drow = Drow + 1 ' ← 追加
Next
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Set ws2 = Nothing
Set ws1 = Nothing
End Sub
回答ありがとうございます。すぐに置換できて便利ですね!
置換して実行したところ、
'データをコピー
For row = 3 To ws1.Cells(Srows.Count, 1).End(xlUp).row←ここのSrowsが青くなって、コンパイルエラー、変数が定義されていませんと出ます。
どこを直せばよいでしょうか?
No.5
- 回答日時:
大変申し訳ございません。
間違えが有りました。「Drow = 3 ← 追加」は「Drow = 3 ' ← 追加」にしてください。
「 ws2.Cells(Drow, 25).Value = "おまけ" ' ← 追加」は「ws2.Cells(Drow, 26).Value = "おまけ" ' ← 追加」にしてください。
修正自体が間違っていました。
「For row = 3 To ws1.Cells(rows.Count, 1).End(xlUp).row」は「For Srow = 3 To ws1.Cells(Rows.Count, 1).End(xlUp).row」にしてください。
度々回答ありがとうございます。
実行したところエラーは無いのですが、
AD列2425や2722でも下に行挿入されているので3000以上の場合のみ行挿入したいです。
またY列、Z列、AB列以外は空白になっているので空白にならないようにしたいです。
わかりにくい内容ですみません。。何卒宜しくお願いします。
>Sheet1 AD列(Sheet2ではAB列にあたる)の数値が
>3000以上の行を探しそれぞれ行コピーし
>その下にコピーした行を挿入、
>Sheet2 挿入した行のAB列は0にし、
>Sheet2 挿入した行のY列にはomake-01
>Sheet2 挿入した行Z列にはおまけ、と書くようにする。
No.6
- 回答日時:
No1です
Sum Mainの下のDim定義がある所に
Dim out As Integer
でいけます
ただし、ws2側のRowは全てoutに置き換えないといけませんよ!
今のままだとws1と同じrowに書き込むようになっていますから
No1とNo6をもとに
s2.Cells(Rowをws2.Cells(outにすべて置換し、
Sub Main()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim row As Long
Dim idx As Integer
Dim out As Integer
Dim ColNames
ColNames = Array("略 のようにDim out As Integerを追加し、
'Sheet2のAC列←Sheet1のAE列
ws2.Cells(out, 29).Value = ws1.Cells(row, 31).Value
Nextの下に
'AD列3000以上
IF ws1.Cells(row, 30).Value>=3000 Then
out=out+1
ws2.Rows(out-1 & ":" & out-1).AutoFill Destination:=Rows(out-1 & ":" & out), Type:=xlFillCopy
'Yにomake-01
ws2.Cells(out, 23).Value="omake-01"
'Zにおまけ
ws2.Cells(out, 24).Value="おまけ"
'ABに0
ws2.Cells(out, 26).Value=0
End If
を入れました。
実行時エラー1004、アプリケーションまたはオブジェクト定義のエラーです。と出ます。
何が原因でしょう(T_T)
No.7
- 回答日時:
大変申し訳ございません。
チャント本文を見てませんでした。「If ws1.Cells(Srow, 31).Value >= 3000 Then ' ← 追加」の位置を「For Srow = 3 To ws1.Cells(Rows.Count, 1).End(xlUp).row」のすぐ後に入れ変えて下さい。
多分これで良いと思いますが何かあったら言ってください。
実行したところY、Z、AB列の文字消え空白行追加に(T_T)エクセルはオフィス365です
Sub Main()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim Srow As Long ' SourceRow ← 追加
Dim Drow As Long ' DestinationRow ← 追加
Dim idx As Integer
Dim ColNames
ColNames = Array("出荷指示NO", 中略 "倉庫連絡事項")
中略
'Sheet2のセルの書式および値を全てクリア
ws2.Cells.ClearContents
'セルの書式を「文字列」に設定
ws2.Cells.NumberFormat = "@"
'ヘッダーの設定
For idx = 0 To UBound(ColNames)
ws2.Cells(2, idx + 1).Value = ColNames(idx)
Next
'張付先行セット
Drow = 3 '← 追加
'データをコピー
For Srow = 3 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
'AD列の数値が3000以上の処理
If ws1.Cells(Srow, 31).Value >= 3000 Then ' ← 追加
Drow = Drow + 1 ' ← 追加
ws2.Cells(Drow, 25).Value = "omake-01" ' ← 追加
ws2.Cells(Drow, 26).Value = "おまけ" ' ← 追加
ws2.Cells(Drow, 28).Value = 0 ' ← 追加
End If ' ← 追加
中略
'張付先行セット
Drow = Drow + 1 ' ← 追加
Next
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Set ws2 = Nothing
Set ws1 = Nothing
End Sub
No.8
- 回答日時:
移動するのは「If ws1.Cells(Srow, 31).Value >= 3000 Then ' ← 追加」だけです。
他はそのままにしてみて下さい。Sub Main()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim Srow As Long ' SourceRow ← 追加
Dim Drow As Long ' DestinationRow ← 追加
Dim idx As Integer
Dim ColNames
ColNames = Array("出荷指示NO", 略 "倉庫連絡事項")
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ws2 = ThisWorkbook.Worksheets("Sheet2")
'Sheet2のセルの書式および値を全てクリア
ws2.Cells.ClearContents
'セルの書式を「文字列」に設定
ws2.Cells.NumberFormat = "@"
'ヘッダーの設定
For idx = 0 To UBound(ColNames)
ws2.Cells(2, idx + 1).Value = ColNames(idx)
Next
'張付先行セット
Drow = 3 '← 追加
'データをコピー
For Srow = 3 To ws1.Cells(Rows.Count, 1).End(xlUp).row
If ws1.Cells(Srow, 31).Value >= 3000 Then ' ← 追加
Drowから下は下の方、
'張付先行セット
Drow = Drow + 1 ' ← 追加
Next
の上にあります。
No5と同じ状態になりました(T_T)
(AD列2425や2722でも下に行挿入されます。
またY列、Z列、AB列以外は空白になっています。)
No.9
- 回答日時:
2回に分けても構わないので全て載せてみて下さい。
Sub Main()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
' Dim row As Long ' ← 削除
Dim Srow As Long ' ← 追加
Dim Drow As Long ' ← 追加
Dim idx As Integer
Dim ColNames
ColNames = Array("出荷指示NO", "店舗ID", "配送方法", "配達指定日", "配達時間帯", "代引有無", "配送先名称", "配送先郵便番号", "配送先都道府県", "配送先住所", "配送先電話番号", "送り状備考", "顧客注文日", "配送料金", "代引手数料金", "消費税率(8or10)", "消費税小計(8%)", "消費税小計(10%)", "消費税額", "ポイント使用額", "クーポン金額", "請求合計金額", "購入者名称", "ギフトフラグ", "商品ID", "商品名", "出荷予定数", "商品単価", "倉庫連絡事項")
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ws2 = ThisWorkbook.Worksheets("Sheet2")
'セルの書式および値を全てクリア
ws2.Cells.ClearContents
'セルの書式を「文字列」に設定
ws2.Cells.NumberFormat = "@"
'ヘッダーの設定
For idx = 0 To UBound(ColNames)
ws2.Cells(2, idx + 1).Value = ColNames(idx)
Next
'データをコピー
' For row = 3 To ws1.Cells(Srows.Count, 1).End(xlUp).row ' ← 削除
For Srow = 3 To ws1.Cells(Rows.Count, 1).End(xlUp).row ' ← 追加(置換後「Srows.Count」を「Rows.Count」に変更して下さい)
If ws1.Cells(Srow, 31).Value >= 3000 Then ' ← 追加
'A列←A列
ws2.Cells(Drow, 1).Value = ws1.Cells(Srow, 1).Value
'B列←"01"
ws2.Cells(Drow, 2).Value = "01"
'C列←B列
ws2.Cells(Drow, 3).Value = ws1.Cells(Srow, 2).Value
'D列←C列
If ws1.Cells(Srow, 3).Value = "0" Then
ws2.Cells(Drow, 4).Value = ""
Else
ws2.Cells(Drow, 4).Value = ws1.Cells(Srow, 3).Value
End If
ws2.Cells(Drow, 4).Value = Format(ws1.Cells(Srow, 3).Value, "yyyy/mm/dd")
'E列←D列
Select Case True
Case Len(ws1.Cells(Srow, 4).Value) = 4
ws2.Cells(Drow, 5).Value = Left(ws1.Cells(Srow, 4).Value, 2) & ":00~" & Right(ws1.Cells(Srow, 4).Value, 2) & ":00"
Case ws1.Cells(Srow, 4).Value = "0"
ws2.Cells(Drow, 5).Value = ""
Case ws1.Cells(Srow, 4).Value = "1"
ws2.Cells(Drow, 5).Value = "午前中"
End Select
'F列←E列
Select Case ws1.Cells(Srow, 5).Value
Case "クレジットカード"
ws2.Cells(Drow, 6).Value = "発払い"
Case "代引き"
ws2.Cells(Drow, 6).Value = "代引"
Case Else
ws2.Cells(Drow, 6).Value = ws1.Cells(Srow, 5).Value
End Select
'G列←F列、G列
ws2.Cells(Drow, 7).Value = ws1.Cells(Srow, 6).Value & ws1.Cells(Srow, 7).Value
'H列←H列、I列
ws2.Cells(Drow, 8).Value = ws1.Cells(Srow, 8).Value & ws1.Cells(Srow, 9).Value
'I列←J列
ws2.Cells(Drow, 9).Value = ws1.Cells(Srow, 10).Value
'J列←K列、L列
ws2.Cells(Drow, 10).Value = ws1.Cells(Srow, 11).Value & ws1.Cells(Srow, 12).Value
'K列←M列、N列、O列
ws2.Cells(Drow, 11).Value = ws1.Cells(Srow, 13).Value & ws1.Cells(Srow, 14).Value & ws1.Cells(Srow, 15).Value
'L列←P列
ws2.Cells(Drow, 12).Value = ws1.Cells(Srow, 16).Value
'M列←Q列
' ws2.Cells(Drow, 13).Value = ws1.Cells(Srow, 17).Value ' ← 削除
ws2.Cells(Drow, 13).Value = Format(ws1.Cells(Srow, 17).Value, "yyyy/mm/dd")
'N列←R列
ws2.Cells(Drow, 14).Value = ws1.Cells(Srow, 18).Value
'O列←S列
ws2.Cells(Drow, 15).Value = ws1.Cells(Srow, 19).Value
'P列←"10"
ws2.Cells(Drow, 16).Value = "10"
'R列←T列
ws2.Cells(Drow, 18).Value = ws1.Cells(Srow, 20).Value
'S列←T列
ws2.Cells(Drow, 19).Value = ws1.Cells(Srow, 20).Value
'T列←U列
ws2.Cells(Drow, 20).Value = ws1.Cells(Srow, 21).Value
'U列←V列
ws2.Cells(Drow, 21).Value = ws1.Cells(Srow, 22).Value
'V列←W列
ws2.Cells(Drow, 22).Value = ws1.Cells(Srow, 23).Value
'W列←X列、Y列
ws2.Cells(Drow, 23).Value = ws1.Cells(Srow, 24).Value & ws1.Cells(Srow, 25).Value
'X列←Z列
ws2.Cells(Drow, 24).Value = ws1.Cells(Srow, 26).Value
'Y列←AA列
ws2.Cells(Drow, 25).Value = ws1.Cells(Srow, 27).Value
'中略
'AC列←AE列
ws2.Cells(Drow, 29).Value = ws1.Cells(Srow, 31).Value
Drow = Drow + 1 ' ← 追加
ws2.Cells(Drow, 25).Value = "omake-01" ' ← 追加
ws2.Cells(Drow, 26).Value = "おまけ" ' ← 追加
ws2.Cells(Drow, 28).Value = 0 ' ← 追加
End If ' ← 追加
'張付先行セット
Drow = Drow + 1 ' ← 追加
Next
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Set ws2 = Nothing
Set ws1 = Nothing
End Sub
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) VBAコードが作動せず、どこに問題があるのか教えて下さい。 3 2023/06/13 13:20
- Visual Basic(VBA) エクセルVBAで教えて頂きたいのですが? 2 2022/12/31 20:28
- Visual Basic(VBA) VBA 別ブックからの転記の高速化について VBA 別ブックからの転記の高速化についてご教授下さい。 19 2022/07/26 13:07
- Visual Basic(VBA) VBA初心者です。 2 2022/10/10 11:52
- Visual Basic(VBA) vbaを早くしたい 5 2022/09/09 10:58
- Visual Basic(VBA) VBAで実行時エラー'424' オブジェクトが必要ですと出る 2 2022/10/07 09:25
- Excel(エクセル) なぜExit Subがあるのかわかりません 4 2023/02/19 12:34
- Visual Basic(VBA) ExcelのVBAコードについて教えてください。 6 2022/06/08 12:55
- Visual Basic(VBA) 【VBA】特定のワードが入っている行全体を塗りつぶしたい 4 2022/04/20 15:22
- Excel(エクセル) R列の1111/11/11以外、且つQ列の×の条件で該当行のAからAE列までオレンジに塗りつぶす 2 2022/07/02 10:18
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
既婚で現役のAV女優さんは居ま...
-
別ブックの空白行に転記
-
エクセル最終行の下に貼り付け
-
直線コネクタの中央にコネクタ...
-
エクセルvbaで月と文字の組み合...
-
bluetoothのclass1とclass2の互...
-
VBA ソートすると、1、11、...
-
CDレコの曲の消し方を教えてく...
-
射精したあとの匂いって他人に...
-
おっぱいを舐める
-
1日3回セックスって多いですか...
-
夫にセックスがないのなら他人...
-
彼とのエッチで、彼がイクのが...
-
精液のにおいがほとんど無いの...
-
先日彼氏とラブホに行ったら電...
-
男の精子ってどんな匂いですか、
-
彼女をオカズにして抜くのって...
-
手マンした手って臭いですか?
-
彼のペニスが挿入時に柔らかく...
-
手マンしたあと彼氏の指に私の...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
既婚で現役のAV女優さんは居ま...
-
VBA ソートすると、1、11、...
-
CDレコの曲の消し方を教えてく...
-
VBAが止まります。
-
EXCELで3行を一組にして結合す...
-
大昔から、クンニ、フェラって...
-
シンナーの夏型と冬型の違いは?
-
私は今年で60歳で孤独です。40...
-
別ブックの空白行に転記
-
女性が頼まれなくてもフェラす...
-
直線コネクタの中央にコネクタ...
-
エクセル最終行の下に貼り付け
-
相対参照から絶対参照に変換す...
-
データの平均を1分値にまとめる...
-
Word 黒塗り部分の文字のみ削除...
-
4次元について
-
ウォークマンa30についてです。...
-
Excelで抽出・連続印刷したいです
-
最適な組み合わせの自動計算
-
ExcelVBAで指定文字(この場合...
おすすめ情報
この質問は特に30代・女性の方に
リクエストされています!←これは間違いです、どなたでも回答いただけます
ご回答ありがとうございます。
実行したところ、out=out+1のふたつめのoutが青くなって
コンパイルエラー、変数が定義されていません、と出ました。
どこを修正するとよいでしょうか?