こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

締切り済みの質問

エクセル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で約120件になりSheet2においては、4倍になりますので約480件になります。
そこで Sheet1において12件ごとに、Sheet2,3,4...としたいのです。
Sh1 NO.1~12がSheet2 Sh1 NO.13~24がSheet3 ... 10枚のシートにしたいのですが、このマクロにどのような命令を加えればよろしいでしょうか?
お手数ですがよろしくお願いいたします。

投稿日時 - 2004-11-17 22:10:14

QNo.1089015

a32

困ってます

このQ&Aは役に立ちましたか?

2人が「このQ&Aが役に立った」と投票しています

回答(9)

ANo.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

でいいのでしょうか・・・

投稿日時 - 2004-11-27 00:13:33

ANo.8

質問の
End Sub
の直前に入れてください

(追加物なので)

P.S.

Sheet2の加工でよろしいのですよね・・・
あとSheet2は削除してしまいます。
残しておく場合は下の3行とって下さい。

投稿日時 - 2004-11-19 21:07:21

補足

説明不足で申し訳ありません。
シート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以降は定形フォームになっていますのであらかじめ作成という形にしております。
よろしくお願いいたします。

投稿日時 - 2004-11-24 13:41:07

ANo.7

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

投稿日時 - 2004-11-18 13:37:36

補足

ありがとうございます。
マクロがあまり得意ではありませんのでお手数おかけいたします。
上記マクロはどこに入れればよいのでしょうか?
質問のマクロに入れるものなのか?
それとも別にあらたに作るものでしょうか?
初心者ですのでお手数ですがよろしくお願いいたします。

投稿日時 - 2004-11-19 14:03:28

ANo.6

たびたびすいません

データ破損を防ぐ為、必ずエクセルファイルをコピーしてからお願いします。

投稿日時 - 2004-11-18 02:03:57

補足

すみません 先ほどの補足 右ではなく左です。
よろしくおねがいいたします。

投稿日時 - 2004-11-24 14:00:59

ANo.5

見直したところ色々ダメそうなので全確認・修正しました

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

投稿日時 - 2004-11-18 01:50:11

ANo.4

やっぱり寝ぼけてるかも

ループ文の中身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)

投稿日時 - 2004-11-18 00:40:09

ANo.3

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

手入力でマクロを作成した為と夜遅いので、エクセルファイルをコピーしてお使いください

投稿日時 - 2004-11-18 00:35:21

ANo.2

ごめんなさい

変換ってコピーでなく変換ですか?

投稿日時 - 2004-11-17 22:55:05

補足

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社
一番右の番号を12ごとにsh2からsh11に変換
変換といっても上記のようにsh1 から sh2にあるような形にしています。
最初に掲載したマクロがそれです。

投稿日時 - 2004-11-17 23:03:02

ANo.1

途中参加なので質問がわかりませんが
Sheet1を12件、Sheet2を12件・・・
で,すでにあるSheet2の内容はどこへ?
Sheet3等は作らなければならない?

付加形式でよければ、お答えしますが。

投稿日時 - 2004-11-17 22:24:58

補足

すみません 説明不足でした。
SH1は大元のデータがあります。120件程度
SH2には SH1の1から12番までを変換
SH3には SH1の13から24番までを変換

各シートSH2からSH11はあらかじめ作成しておきます。

これでわかりますか?
よろしくお願いいたします。

投稿日時 - 2004-11-17 22:40:57