Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
13388 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【5624】通知したいのですが koshimizu 03/5/22(木) 15:35 質問
【5632】Re:通知したいのですが ハマゾウ 03/5/23(金) 0:53 回答
【5633】Re:通知したいのですが Kein 03/5/23(金) 2:17 回答
【5624】通知したいのですが
質問  koshimizu E-MAIL  - 03/5/22(木) 15:35 -
引用なし
パスワード
   こんなことが出来るでしょうか？

下記のようなシートがあります。
　Ｂ列　　Ｃ列　　Ｄ列　　　Ｇ列　　　Ｔ列
　番号　スポーツ　氏名　　チーム名　　ランク
　１　　サッカー　○○○　東京　　　　　Ａ
　２　　バレー　　×××　東京　　　　　Ｂ
　３　　サッカー　○×○　東京　　　　　Ｂ
　４　　バレー　　××○　横浜　　　　　Ａ

上記の表を元に下記のような表を印刷したいのですが

１の表

　東京

　番号　　スポーツ　　氏名　　　ランク
　１　　　サッカー　　○○○　　　Ａ
　２　　　バレー　　　×××　　　Ｂ
　３　　　サッカー　　○×○　　　Ｂ

２の表
　横浜

　番号　　スポーツ　　氏名　　　ランク
　４　　　バレー　　　××○　　　Ａ
３の表

以上のようにＧ列を表題に
Ｂ列　Ｃ列　Ｄ列　Ｔ列を人数分（人数はランダム）表印刷したいのですが
なにか良い方法がありましたならば御教えください。
ＶＢＡは初心者です。
【5632】Re:通知したいのですが
回答  ハマゾウ E-MAILWEB  - 03/5/23(金) 0:53 -
引用なし
パスワード
   ▼koshimizu さん：
以下のコードをお試しください。
データシート名は"Sheet1"、出力シートは"Sheet2"としています。

Sub test()
　　Dim Team As String
　　Dim DataSheet As String
　　Dim OutputSheet As String
　　Dim i As Integer
　　Dim j As Integer
　　
　　'初期設定
　　DataSheet = "Sheet1"
　　OutputSheet = "Sheet2"
　　Sheets(OutputSheet).Cells.ClearContents
　　Sheets(OutputSheet).Cells(1, 1) = "番号"
　　Sheets(OutputSheet).Cells(1, 2) = "スポーツ"
　　Sheets(OutputSheet).Cells(1, 3) = "氏名"
　　Sheets(OutputSheet).Cells(1, 4) = "ランク"
　　
　　Team = InputBox("チーム名の入力")
　　i = 1
　　j = 2
　　Do
　　　　i = i + 1
　　　　If Sheets(DataSheet).Cells(i, 2) = "" Then Exit Do
　　　　If Sheets(DataSheet).Cells(i, 7) = Team Then
　　　　　　Sheets(OutputSheet).Cells(j, 1) = Sheets(DataSheet).Cells(i, 2)
　　　　　　Sheets(OutputSheet).Cells(j, 2) = Sheets(DataSheet).Cells(i, 3)
　　　　　　Sheets(OutputSheet).Cells(j, 3) = Sheets(DataSheet).Cells(i, 4)
　　　　　　Sheets(OutputSheet).Cells(j, 4) = Sheets(DataSheet).Cells(i, 20)
　　　　　　j = j + 1
　　　　End If
　　Loop
　　Sheets(OutputSheet).Select
　　
End Sub
【5633】Re:通知したいのですが
回答  Kein  - 03/5/23(金) 2:17 -
引用なし
パスワード
   こんな感じで、どうでしょーか ?

Sub Test_Print()
　 Dim MyR As Range, FlR As Range, C As Range
　 Dim Pl As Long

　 Set MyR = Range("A1").CurrentRegion
　 Set FlR = Range("D1", Range("D65536").End(xlUp))
　 FlR.AdvancedFilter xlFilterCopy, , Range("AA1"), True
　 Application.ScreenUpdating = False
　 Columns(4).Hidden = True
　 On Error GoTo ErLine
　 For Each C In Range("AA2", Range("AA65536").End(xlUp))
　　　Pl = WorksheetFunction.CountIf(FlR, C.Value)
　　　FlR.AutoFilter 1, C.Value
　　　MyR.PrintOut Copies:=Pl
　 Next
ErLine:
　 Columns(4).Hidden = False
　 ActiveSheet.AutoFilterMode = False
　 Columns(27).ClearContents
　 Application.ScreenUpdating = True
　 Set MyR = Nothing: Set FlR = Nothing
End Sub
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
13388 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free