• 締切済み

Excel・VBAのコード教えてください。

1シートに12ずつあるまとまりを印刷したくて下記のようなものを作成しました。 Worksheets("Sheet1").Select Last = Cells(1).CurrentRegion.Rows.Count Warizan = Abs(Last / 12)    ←12個以上の場合2、3…以下は1となる。 Kaisuu = Left(Warizan, 1) For r = 1 To Kaisuu      ←回数分繰り返す For i = 2 To Last      ←シート1に書かれたデータの最終行まで。 Worksheets("Sheet1").Select Company = Cells(i, 1) Yuubin = Cells(i, 2) Address = Cells(i, 3) Worksheets("Sheet2").Select Select Case i Case (Kaisuu * 12) - 10 Range("D4") = Yuubin Case (Kaisuu * 12) - 9 Range("AF4") = Yuubin        : Case (Kaisuu * 12) - 1 Range("AF45") = Yuubin Case (Kaisuu * 12) Range("D56") = Yuubin Case (Kaisuu * 12) + 1 Range("AF56") = Yuubin End Select Next ActiveWindow.SelectedSheets.PrintPreview Next とした時に、最終ページが2回、もしくは3回…と表示されてしまいます。 例えばデータが25個あったとして、1ページ目(12個分)が終ったらプレビュー、残りの2ページ目(1個分)を表示、としたいのです。 よろしくお願いします。

みんなの回答

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.3

>Warizan = Abs(Last / 12)    ←12個以上の場合2、3…以下は1となる。 ABS(絶対値)を使う意味は判りません。 W=int(Last/12)+1 では。 >sheet1、Sheet2が出てくる意味は。 LastはSheet1の最終行でありながら、何故突然sheet2 出てくるのでしょう。 >Case文のところは何をしているのでしょう。 >下記(テスト済み)では、どう言う点が満たされていないですか。12行ずつsheet1をpreviewします。 Sub test01() last = Range("a1").CurrentRegion.Rows.Count MsgBox last w = Int(last / 12) + 1 For i = 1 To w Range(Cells((i - 1) * 12 + 1, 1), Cells(i * 12, 12)).PrintPreview Next i End Sub

  • ki-aaa
  • ベストアンサー率49% (105/213)
回答No.2

>例えばデータが25個あったとして >Last = Cells(1).CurrentRegion.Rows.Count これで、Lastに、25がセットされる。 >Warizan = Abs(Last / 12)    ←12個以上の場合2、3…以下は1となる。 >Kaisuu = Left(Warizan, 1) これで、Kaisuuに、3がセットされる。 >For r = 1 To Kaisuu      ←回数分繰り返す 3回繰り返す。 >For i = 2 To Last Lastが25だから、24回繰り返す。 >Select Case i >Case (Kaisuu * 12) - 10 Kaisuuが3のとき、当てはまるケースが無いので、 Sheet2はKaisuuが2のときのままである。 対策1 Warizan = Abs(Last / 12) →Warizan = Abs((Last - 1)/ 12) 対策2 For r = 1 To Kaisuu      ←回数分繰り返す ***** ここでSheet2のクリアをやる。 For i = 2 To Last      ←シート1に書かれたデータの最終行まで。

  • 0shiete
  • ベストアンサー率30% (148/492)
回答No.1

>例えばデータが25個あったとして、1ページ目(12個分)が終ったらプレビュー、残りの2ページ目(1個分)を表示、としたいのです。 25÷12=2余り1なので、3ページあるわけではないのですか? 残りの2ページ目(1個分)というのはどういうことでしょうか?

関連するQ&A

  • Excel関数とVBAの組み合わせで。

    名前  |  総合計  |  ランキング あああ |  10    |   3 いいい |  12    |   2 ううう  |  8     |  4 えええ |   20    |  1 おおお |  4     |   5 というような感じでシートに入力されています。 (ランキングの部分はRANK関数を使用) これを元にグラフを作成するために、1位から3位までを変動的に抽出するようなコードを下記のようにしました。 -------------------------------------------------- Sub IP_Graph() Dim i As Integer Dim Ranking As String Dim Provider As String Dim AccessCount As String Dim Last As Integer '最終行取得 Last = Cells(2).CurrentRegion.Rows.Count For i = 3 To Last Ranking = Cells(i, 10) Provider = Cells(i, 2) AccessCount = Cells(i, 9) Select Case Ranking Case 1 Range("p_01") = Cells(i, 1) Range("access_01") = Cells(i, 2) Case 2 Range("p_02") = Cells(i, 1) Range("access_02") = Cells(i, 2) Case 3 Range("p_03") = Cells(i, 1) Range("access_03") = Cells(i, 2) End Select Next End Sub -------------------------------------------------- 上のように、1位から5位まで、ときちおんとランク分けされていればいいのですが、 実際は同じ数でランキングが同位だったりすることがおこります。 (例えば1位・2位・2位・4位・5位のように。) このような場合抜き出して作成した表の3位の部分が空欄になってしまいます。 上位3つを抜き出すためにはどうしたらいいのでしょうか? 表示上の並べ替えは行いたくないです。 Ex:2000

  • 下記エクセルVBAコード:改良 表

    下記エクセルVBAコードの中で Case "a" Case "b" Case "c" などの情報を処理していますが、その”a”、"b"、"c"の代わりに、$A$50~$A$52の表の中(ここにaとか入っている)のデータを用いて処理できるようにするには、どのようにコードを変更すべきでしょうか。よろしくお願いします。 Sub test01() d = Range("A65536").End(xlUp).Row j = 1 For i = 1 To d Select Case Cells(i, "a") Case "a" Case "b" Case "c" '---XXX Case Else Worksheets("Sheet2").Cells(j, "A") = Cells(i, "A") Worksheets("Sheet2").Cells(j, "B") = Cells(i, "b") 列や行やシートが変わっても、類推で変えられるでしょう。 '---YYY j = j + 1 End Select Next i End Sub

  • excel・VBAで奇数・偶数の分岐がうまくいかない。

    一覧が入っているシートから宛名用のシール印刷をするために、VBAを使用しています。 ラベル印刷は ┏━━━━┓┏━━━━┓ ┃ 奇数 ┃┃ 偶数 ┃ ┗━━━━┛┗━━━━┛ みたいな感じです。 奇数:一覧シートの奇数行 偶数:一覧シートの偶数行 ですが、奇数の方はうまく出るのですが、偶数の方が1つおきになってしまいます。 これのどこが間違っているのでしょうか? Worksheets("Sheet1").Select Last = Cells(1).CurrentRegion.Rows.Count For i = 2 To Last Worksheets("Sheet1").Select Yuubin = Cells(i, 1) Name = Cells(i, 6) Dim AllCount As Integer Worksheets("TEST").Select Kotae = i / 2 Amari = i Mod 2 AllCount = i / 12 If Amari = 0 Then Ichi = (((Kotae - 1) * 9) + 1) - AllCount Cells(Ichi, 2) = "〒" & Left(Yuubin, 3) & "-" & Right(Yuubin, 4) Cells(Ichi + 7, 4) = Name & " 様" ElseIf Amari = 1 Then Ichi = (((Kotae - 1) * 9) + 1) - AllCount Cells(Ichi, 17) = "〒" & Left(Yuubin, 3) & "-" & Right(Yuubin, 4) Cells(Ichi + 7, 19) = Name & " 様" & i End If '奇数偶数分岐 Next ' 全件分終るまで よろしくお願いします。

  • ExcelのVBAでシート選択・最終行取得がうまくいかない。

    シートA・Bがあり、シートAの変数markが★だったら、シートBへいき、最終行を取得、ということをしたくて以下のようなコードをかきました。 Worksheets("A").Select Last3 = Cells(6).CurrentRegion.Rows.Count Worksheets("B").Select Last1 = Cells(6).CurrentRegion.Rows.Count For w = 1 To Last1 Worksheets("B").Select Mark = Cells(w, 26) If Mark = "★" Then Sheets("A").Select Last3 = Cells(6).CurrentRegion.Rows.Count MsgBox Last3 End If Next ですが、シートAの最終行が表示されます。 どこがちがうのでしょうか?

  • VBAのコードについて質問です

    独学でエクセルVBAの初心者です。 定尺の鋼材から一定の長さのものが何本切り出せるかを調べるプログラムを作りたいです。 ネットで調べたところカッティングストック問題というものすごい難しいサイトに当たりましたが、 そのような難しいものではなく単純に同じ長さのものを切っていき、必要本数が取れたら次の長さを 切っていくというものを作りたいと思います(最終的に定尺何本必要か知りたい)。 まだまだ始めたばかりなのですが、do while文でorを使ったのですが反映されません。 なぜなのでしょうか? iが3になった時点で引くのを止めたいのですが止まりません教えてください。 Sub Test() Worksheets("Sheet1").Cells(1, 2).Value = 5500 Worksheets("Sheet1").Cells(2, 2).Value = 1000 Worksheets("Sheet1").Cells(3, 2).Value = Range("B1").Value Dim i i = 0 Do While Range("B3").Value > Range("B2").Value Or Range("B4").Value = 3 i = i + 1                           ↑この部分 Range("B3").Value = Range("B3").Value - Range("B2").Value Loop Worksheets("Sheet1").Cells(3, 2).Value = Range("B3").Value Worksheets("Sheet1").Cells(4, 2).Value = i End Sub

  • コードの、どこが間違ってますか?

    下記は、選択した1つのシートだけしか、実行されませんが、どこが間違ってますか? よろしくお願い致します。 ---- Sub 不要な行を削除する() Dim i As Integer On Error Resume Next For i = 9 To Worksheets.Count Worksheets(i).Range(Cells(4, 6).End(xlDown).Offset(2, 0).EntireRow, Cells(4, 6).End(xlDown).Offset(12, 0).EntireRow).Select Selection.Delete Shift:=xlUp Next i  End Sub ----

  • VBA超初心者です

    皆さんのお知恵を拝借させてください。 Sub Macro1() ' ' Macro1 Macro ' マクロ記録日 : 2007/12/1 ユーザー名 : 101 ' Dim pearend As Integer Dim code As Integer Dim codeend As Integer Dim sheet_name As String Dim dayend As Date Sheets("商品名").Select Range("A4").Select Selection.End(xlDown).Select pearend = Selection.Row() For l = 4 To pearend Step 2 For r = 2 To 3 Cells(l, r).Select code = Cells(l, r).Value Select Case code Case 1000 To 1999 sheet_name = "1000" Case 2000 To 2999 sheet_name = "2000" Case 3000 To 3999 ssheet_name = "3000" Case 4000 To 4999 sheet_name = "4000" Case 5000 To 5999 sheet_name = "5000" End Select Sheets(sheet_name).Select Range("B4").Select Selection.End(xlToRight).Select codeend = Selection.Column() Range("A5").Select Selection.End(xlDown).Select dayend = Selection.Row() For i = 2 To codeend If code = Cells(4, i).Value Then Range(Cells(dayend, i), Cells(5, i)).Select Selection.Copy Sheets("商品名").Select Range("K3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End If Next Next Next End Sub というマクロをつくってみたのですが、何順目かあたりから For r = 2 To 3 のrがなぜか4になっています。正直知識がないのでさっぱりわかりません。どこに問題があるか詳しい方教えてください。

  • VBA Excel2003 謎のエラー

    いろいろ検索してみたのですが、問題が解決できません。 エクセルのSheet1のA1からG16のセルの内容を一つずつ感知し、マイナスだったら赤、プラスだったら緑、それ以外だったら何もしないという処理にしたいです。 Private Sub Workbook_Open() ThisWorkbook.Sheets("Sheet1").Select ThisWorkbook.Sheets("Sheet1").Range("A1").Select Dim 英語 As Integer Dim 数字 As Integer Dim sheet1 As Worksheets sh1 = Worksheets("Sheet1") sh1.Activate 英語 = 1 数字 = 1 For 数字 = 1 To 16 For 英語 = 1 To 6 '選択位置が、マイナスだったら赤、プラスだったら緑、それ以外は無視 If Range(sh1.Cells(英語 & 数字)) < 0 Then Range(sh1.Cells(英語 & 数字)).Interior.ColorIndex = 7 ElseIf Range(sh1.Cells(英語 & 数字)) > 0 Then Range(sh1.Cells(英語 & 数字)).Interior.ColorIndex = 4 Else Range(sh1.Cells(英語 & 数字)).Interior.ColorIndex = 0 End If 英語 = 英語 + 1 Next 英語 数字 = 数字 + 1 Next 数字 End Sub

  • エクセル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枚のシートにしたいのですが、このマクロにどのような命令を加えればよろしいでしょうか? お手数ですがよろしくお願いいたします。

  • ExcelのVBAの配列に関する質問です。

    ExcelのVBAの配列に関する質問です。 sheet1のデータをsheet2に表示するVBAを作成しています。。 sheet1のデータは7行目からスタートし、sheet2のデータは26行目からスタートしています。。 sheet1とsheet2の列は同じ並びではないため、それぞれのシートの列番号をCellsを用いて指定しています。 Sub test1() Dim endrow As Long endrow = Worksheets("sheet1").Range("A65536").End(xlUp).Row Dim i As Long Dim j As Long For i = 7 To endrow j = i + 19 Worksheets("sheet2").Cells(j, 1) = Worksheets("sheet1").Cells(i, 2) Worksheets("sheet2").Cells(j, 8) = Worksheets("sheet1").Cells(i, 28) Worksheets("sheet2").Cells(j, 9) = Worksheets("sheet1").Cells(i, 31) Worksheets("sheet2").Cells(j, 10) = Worksheets("sheet1").Cells(i, 32) ・ ・ ・ ※長いので省略 Next i End Sub 上記のtest1は正常に動くのですが、データ量が多いため、処理に時間がかかってしまいます。 高速化できないかと、以下のように変更しました。 Sub test2() Dim dataRange1 As Variant Dim dataRange2 As Variant dataRange1 = Worksheets("sheet1").Range("A1:GI10006") dataRange2 = Worksheets("sheet2").Range("A1:DZ10018") Dim endrow As Long endrow = Worksheets("sheet1").Range("A65536").End(xlUp).Row Dim i As Long Dim j As Long For i = 7 To endrow j = i + 19 dataRange2(j, 1) = dataRange1(i, 2) dataRange2(j, 8) = dataRange1(i, 28) dataRange2(j, 9) = dataRange1(i, 31) dataRange2(j, 10) = dataRange1(i, 32) ・ ・ ・ ※長いので省略 Next i End Sub test2は、エラーメッセージ等は表示されませんが、sheet2にデータが表示されません。 ちなみに、以下のようにsheet1のみ配列化した場合は、正常に表示されました。 Worksheets("sheet2").Cells(j, 1) = dataRange1(i, 2) Worksheets("sheet2").Cells(j, 8) = dataRange1(i, 28) Worksheets("sheet2").Cells(j, 9) = dataRange1(i, 31) Worksheets("sheet2").Cells(j, 10) = dataRange1(i, 32) test2は、どこが間違っているのでしょうか? ご教示ください。 よろしくお願いいたします。

専門家に質問してみよう