- 締切済み
エクセルVBAについて
前回質問させていただきました件の追加機能になります。以前質問させていただきましたマクロが下記のものです。 Sub TESTa() Dim A As Long Dim B As Long Dim C As Long Dim D As Long Dim E As Long Dim F As Long '表の行数を調べる A = Worksheets("sheet1").Range("C65536").End(xlUp).Row - 1 For C = 1 To A For B = 4 To 7 'Sheet1のデータをSheet2に複写する Worksheets("Sheet2").Cells(B - 3 + D, 15) = Worksheets("Sheet1").Cells(C + 1, 1) Worksheets("Sheet2").Cells(B - 3 + D, 6) = Worksheets("Sheet1").Cells(C + 1, B) Worksheets("Sheet2").Cells(B - 3 + D, 14) = Worksheets("Sheet1").Cells(C + 1, 3) Worksheets("Sheet2").Cells(B - 3 + D, 10) = Worksheets("Sheet1").Cells(1, B) Worksheets("Sheet2").Cells(B - 3 + D, 13) = Worksheets("Sheet1").Cells(C + 1, 2) Next D = C * 4 Next 'Sheet2の表の行数を調べる Sheets("Sheet2").Select E = Worksheets("sheet2").Range("F65536").End(xlUp).Row '0欄の確認 For F = E To 1 Step -1 If Worksheets("Sheet2").Cells(F, 6) = 0 Then '0の場合は行を削除する Cells(F, 1).EntireRow.Delete End If Next End Sub カウントするとデータ個数がSheet1で約１２０件になりSheet2においては、４倍になりますので約４８０件になります。 そこで Sheet1において１２件ごとに、Sheet2,3,4...としたいのです。 Sh1 NO.1～12がSheet2 Sh1 NO.13～24がSheet3 ... 10枚のシートにしたいのですが、このマクロにどのような命令を加えればよろしいでしょうか？ お手数ですがよろしくお願いいたします。
- みんなの回答 （9）
- 専門家の回答
みんなの回答
これで出来なければギブアップということで Sheet1の加工ですね。上記の件は関係ないですね。 Sheets("Sheet1").Select A = range("A65536").End(xlUp).Row D = 2: E = 1 'シート数と入力行数 F = 13 '件数 For B = 1 To A Step 1 If range("A" & B) = F Then D = D + 1: E = 1: F = F + 12 End If Sheets("sheet" & D).range("A" & E) = range("A" & B) Sheets("sheet" & D).range("B" & E) = range("B" & B) Sheets("sheet" & D).range("C" & E) = range("C" & B) Sheets("sheet" & D).range("D" & E) = range("D" & B) Sheets("sheet" & D).range("E" & E) = range("E" & B) E = E + 1 Next でいいのでしょうか・・・
質問の End Sub の直前に入れてください （追加物なので） P.S. Sheet2の加工でよろしいのですよね・・・ あとSheet2は削除してしまいます。 残しておく場合は下の3行とって下さい。
Excelで確認取りました 長い間すいません Dim na_mae As String '作業シート追加 Sheets("Sheet2").Select Sheets("Sheet2").Copy Before:=Sheets(2) na_mae = activesheet.name 'すでにあるSheet2を削除 Sheets("Sheet2").range("A1:AA10000").clearcontents A = Worksheets(na_mae).range("A65536").End(xlUp).Row D = 2: E = 1 'シート数と入力行数 F = 13 '件数 For B = 1 To A Step 1 If range("A" & B) = F Then D = D + 1: E = 1: F = F + 12 End If Sheets("sheet" & D).range("A" & E) = range("A" & B) Sheets("sheet" & D).range("B" & E) = range("B" & B) Sheets("sheet" & D).range("C" & E) = range("C" & B) Sheets("sheet" & D).range("D" & E) = range("D" & B) Sheets("sheet" & D).range("E" & E) = range("E" & B) E = E + 1 Next application.displayalerts = False Sheets(na_mae).delete application.displayalerts = True
補足
ありがとうございます。 マクロがあまり得意ではありませんのでお手数おかけいたします。 上記マクロはどこに入れればよいのでしょうか？ 質問のマクロに入れるものなのか？ それとも別にあらたに作るものでしょうか？ 初心者ですのでお手数ですがよろしくお願いいたします。
たびたびすいません データ破損を防ぐ為、必ずエクセルファイルをコピーしてからお願いします。
補足
すみません 先ほどの補足 右ではなく左です。 よろしくおねがいいたします。
見直したところ色々ダメそうなので全確認・修正しました dim na_mae as string '作業シート追加 sheets("Sheet2").copy befor:=Sheets(2) na_mae=activesheet.name 'すでにあるSheet2を削除 Sheets("Sheet2").range("A1:AA10000").clearcontents A=Worksheets(na_mae).Range("F65536").End(xlUp).Row D=2:E=1 'シート数と入力行数 F=13 '件数 for B = 1 to A step 1 if range("A1")=F D=D+1:E=1:F=F+12 end if sheets("sheet" & D).range("A" & E)=range("A" & B) sheets("sheet" & D).range("B" & E)=range("B" & B) sheets("sheet" & D).range("C" & E)=range("C" & B) sheets("sheet" & D).range("D" & E)=range("D" & B) sheets("sheet" & D).range("E" & E)=range("E" & B) E=E+1 next application.displayalerts=false sheets(na_mae).delete application.displayalerts=true
やっぱり寝ぼけてるかも ループ文の中身A列しか処理していなかった sheets("sheet" & D).range("A" & E)=range("A" & B) この後追加 sheets("sheet" & D).range("B" & E)=range("B" & B) sheets("sheet" & D).range("C" & E)=range("C" & B) sheets("sheet" & D).range("D" & E)=range("D" & B) sheets("sheet" & D).range("E" & E)=range("E" & B)
dim na_mae as string '作業シート追加 sheets("Sheet2").copy befor:=Sheets(2) na_mae=activesheet.name 'すでにあるSheet2を削除 Sheets("Sheet2").range("A1:AA10000").clearcontents A=Worksheetsna_mae).Range("F65536").End(xlUp).Row D=2:E=1 'シート数と入力行数 F=13 '件数 for B = 1 to A step 1 if range("A1")=F D=D+1:E=1:F=F+12 end if sheets("sheet" & D).range("A" & E)=range("A" & B) next application.displayalerts=false sheets(na_mae).delete application.displayalerts=true 手入力でマクロを作成した為と夜遅いので、エクセルファイルをコピーしてお使いください
ごめんなさい 変換ってコピーでなく変換ですか？
補足
sh1 No 日付 顧客名 請求金額 立替金 非課税 課税 1 01 A社 2010 1500 300 210 2 04 B社 5100 2000 1000 2100 3 05 C社 10200 6000 0 4200 ↓ sh2～sh11 No 1 2010 A社 請求金額 01 1 1500 A社 立替金 01 1 300 A社 課税 01 1 210 A社 非課税 01 2 5100 B社 ↓ 02 2 2000 B社 02 2 1000 B社 02 2 2100 B社 02 3 10200 C社 ↓ 3 6000 C社 3 0 C社 3 4200 C社 一番右の番号を１２ごとにsh2からsh11に変換 変換といっても上記のようにsh1 から sh2にあるような形にしています。 最初に掲載したマクロがそれです。
途中参加なので質問がわかりませんが Sheet1を12件、Sheet2を12件・・・ で,すでにあるSheet2の内容はどこへ？ Sheet3等は作らなければならない？ 付加形式でよければ、お答えしますが。
補足
すみません 説明不足でした。 SH1は大元のデータがあります。１２０件程度 SH2には SH1の１から１２番までを変換 SH3には SH1の１３から２４番までを変換 各シートSH2からSH11はあらかじめ作成しておきます。 これでわかりますか？ よろしくお願いいたします。
補足
説明不足で申し訳ありません。 シート1には下記の表 NO 顧客名 請求金額 立替 課税 非課税 1 A 5050 3000 1050 1000 2 B 10150 7000 3150 0 3 C 20100 16000 2100 2000 ↓ NO 1 A 請求金額 5050 1 A 立替 3000 1 A 課税 1050 1 A 非課税 1000 2 B 請求金額 10150 2 B 立替 7000 2 B 課税 3150 2 B 非課税 0 ・ ・ ・ 最後に0の行を削除するマクロなのです。 右の番号が、1ヶ月間で120番くらいになります。 シート1には大元の表 1番上のものになり 現在のマクロだとシート2に縦並びの表になります。 シート1の番号（一番右）の12ごとにシートを1枚作成したいのです。 番号の1から12をシート2へ 番号の13から24をシート3へ 番号25から36をシート3へ といった形にしたいのです。 シートはあらかじめシート11まで作成しておきます。 自動で追加や削除はしないです。シート2以降は定形フォームになっていますのであらかじめ作成という形にしております。 よろしくお願いいたします。