Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

13981 / 76738

←次へ　｜　前へ→


	【68257】Re:Excel表の振り分け処理について

kanabun - 11/2/18(金) 20:04 -


	引用なし

	パスワード

▼VBA初心者さん：

>1行目と２行目を見出しとしてコピーして、１行目と２行目は固定
>してExcel表に出力したいです。
>
>'◆見出し行をCopyしてのところを[A1:A2]にしたり、Tbl.Rows(2).Copy
>にしたりしても２行目だけ出力されたりしてしまいます。

>Sub Lesson_Print()
>　　Dim Tbl As Range
>　　Dim v, i As Long, n As Long, n1 As Long
>　　Dim myPath As String
>　　Dim nSheet As Long
>　　Dim newBook As Workbook
>　　Dim Bookname As String
>　　
>　　With Application
>　　　　nSheet = .SheetsInNewWorkbook
>　　　　.SheetsInNewWorkbook = 1
>　　　　.DisplayAlerts = False
>　　End With
>　　
>　　myPath = ActiveWorkbook.Path & "\"
>　　Set Tbl = ActiveSheet.[A1].CurrentRegion '◆ A列で Sort済み
>　　n = Tbl.Rows.Count
>　　v = Tbl.Resize(Tbl.Rows.Count + 1, 1).Value
>　　n1 = 2
>　　For i = 2 To n
>　　　　If v(i, 1) <> v(i + 1, 1) Then '下と違えば
>　　　　　　With Workbooks.Add
>　　　　　　　　Tbl.Rows(1).Copy .Sheets(1).[A1]　'◆見出し行をCopy
>　　　　　　　　Tbl.Rows(n1 & ":" & i).Copy .Sheets(1).[A2]
>
>　　　　　　　　.Sheets(1).UsedRange.EntireColumn.AutoFit　'◆挿入
>
>　　（中　略）
>
>　　Application.SheetsInNewWorkbook = nSheet
>　　
>　　MsgBox "出力しました"
>
>End Sub

この部分、こんな感じにしてみたらどうですか？

Sub Lesson_Print2()　'タイトル2行
　　Dim Tbl As Range
　　Dim v, i As Long, n As Long, n1 As Long
　　Dim myPath As String
　　Dim newBook As Workbook
　　Dim Bookname As String
　
　　Application.DisplayAlerts = False
　
　　myPath = ActiveWorkbook.Path & "\"
　　Set Tbl = ActiveSheet.[A1].CurrentRegion '◆ A列で Sort済み
　　n = Tbl.Rows.Count
　　v = Tbl.Resize(n + 1, 1).Value
　　n1 = 3　　　　'◆変更
　　For i = 3 To n '◆変更
　　　　If v(i, 1) <> v(i + 1, 1) Then '下と違えば
　　　　　　With Workbooks.Add(xlWBATWorksheet) '◆変更　シート1枚のBook
　　　　　　　　Tbl.Rows("1:2").Copy .Sheets(1).[A1]　'◆見出し行2行をCopy
　　　　　　　　Tbl.Rows(n1 & ":" & i).Copy .Sheets(1).[A3] '3行目へ

　　　　　　　　.Sheets(1).UsedRange.EntireColumn.AutoFit　'◆挿入

>　　（中　略）
>
　　'Application.SheetsInNewWorkbook = nSheet
>　　
>　　MsgBox "出力しました"
>
>End Sub

0 hits

▼

【68256】Excel表の振り分け処理について VBA初心者 11/2/18(金) 18:12