Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
13110 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【6957】別シートで結合したセルで印刷したい 困ったもんだ 03/8/15(金) 14:12 質問
【6958】Re:別シートで結合したセルで印刷したい Jaka 03/8/15(金) 15:56 回答
【6959】Re:別シートで結合したセルで印刷したい 困ったもんだ 03/8/15(金) 20:28 質問
【6978】Re:別シートで結合したセルで印刷したい Jaka 03/8/18(月) 13:42 回答
【6957】別シートで結合したセルで印刷したい
質問  困ったもんだ  - 03/8/15(金) 14:12 -
引用なし
パスワード
   初めまして、VBA初心者です。よろしくお願いいたします。
エクセルでフォームを作り、セルに打ち込みは出来たのですが、名前をあいうえお順に並び替えをしたいのと別のシートに印刷用を作り結合したセルにあいうえお順に並び替えたまま印刷をしたいのですがやり方が分かりません。よろしくお願いいたします。

あいうえお順並び替え　　　　　　　　　　　別シートの印刷用　　　　
　　　A　　　B　　　C　　　　D　　　　　A　　B　　C　　　D　　　E　　　F
1　名前　　住所　電話番号　金額　　　1　A2　　　　　　　C2
2　XXXX　XXXXXX　XX-XXXX　XXXXX　　2　　　　 　B2 　　　　　　　D2
3　XXXX　XXXXXX　XX-XXXX　XXXXX　　3　　　
4　　　　　　　　　　　　　　　　 4　　 A3　 　　　　　 C3　　　
5　　　　　　　　　　　　　　　　　　5　　　　　 B3　　　　　　　 D3　
’
’
’　　　　　　　　　　　　　　　　　　　　　　　　　　　　
【6958】Re:別シートで結合したセルで印刷したい
回答  Jaka  - 03/8/15(金) 15:56 -
引用なし
パスワード
   こんにちは。
フォームから書きこんだ文字などは、フリガナの情報を持っていないため、お望みのソート結果にはならないと思います。
フォームにフリガナの欄を設け、それをフリガナ専用セルを作って代入して下さい。
（私のは、97なので漢字のフリガナを直す機能が無いので解りませんのでこういった方法しかできません。）
ソートと印刷は、マクロ記録でもして下さい。
結合したセル、状態がわからないんで全く考えていません。

Sub llll()
　　Dim EndR As Long, i As Long, ii As Long
　　EndR = Range("A65535").End(xlUp).Row
　　ii = 1
　　For i = 2 To EndR
　　　　Sheets("印刷用").Cells(ii, 1).Value = Cells(i, 1).Value
　　　　Sheets("印刷用").Cells(ii, 1).Offset(1, 1).Value = Cells(i, 2).Value
　　　　Sheets("印刷用").Cells(ii, 1).Offset(, 2).Value = Cells(i, 3).Value
　　　　Sheets("印刷用").Cells(ii, 1).Offset(1, 3).Value = Cells(i, 4).Value
　　　　ii = ii + 3
　　Next
End Sub
【6959】Re:別シートで結合したセルで印刷したい
質問  困ったもんだ  - 03/8/15(金) 20:28 -
引用なし
パスワード
   JaKa様
ご回答有難う御座います。
並び替えは別にフリガナの列を完了しました。有難う御座います。
印刷用のシートは説明不足ですみません。
明確に言うとA4のデータを印刷用のシートのA2に写し、B4がF2、C4がF4、D4がI4、E4がL4、F4がL2　これが、1ブロックの単位で　2ブロックが　A5がA9　B5がF9　C5がF11
D5がI11、E5がL11、F5がL9　　基のシートでは1段ずつ降りていますが、移す方はA2、F2、F4、I4、L4、L2を基にA9、F9、F9、F11、I11、L11と7段ずつ下がっています。それを100ブロック以上作らなければいけません、=A2　でもいいのですが全部設定して空白があると"0"の数字が印刷されてしまします。コードで書きたいのですがよろしくお願いいたします。
【6978】Re:別シートで結合したセルで印刷したい
回答  Jaka  - 03/8/18(月) 13:42 -
引用なし
パスワード
   う〜ん。応用が利かないって事なんでしょうか？
あまり良く理解していませんが．．．。

>=A2　でもいいのですが全部設定して空白があると"0"の数字が印刷されてしまします。
こうすれば良かったのでは。
=IF(A2="","",A2)

Offsetプロパティーが解らなかったら、ヘルプで調べてください。
Sub djj()
　　Dim EndR As Long, i As Long
　　Sh2R = 2
　　EndR = Sheets("Sheet1").Range("A65536").End(xlUp).Row
　　For i = 4 To EndR
　　　 With Sheets("Sheet2").Cells(Sh2R, 1)
　　　　　 .Value = "シート１ " & Sheets("Sheet1").Range("A" & i).Address(0, 0) & "行の場合、" _
　　　　　　　　　　& .Address(0, 0) & "のセルを基点にする。"
　　　　　 .Offset(0, 5).Value = "シート１ " & Sheets("Sheet1").Range("B" & i).Address(0, 0)
　　　　　 .Offset(2, 5).Value = "シート１ " & Sheets("Sheet1").Range("C" & i).Address(0, 0)
　　　　　 .Offset(2, 8).Value = "シート１ " & Sheets("Sheet1").Range("D" & i).Address(0, 0)
　　　　　 .Offset(0, 11).Value = "シート１ " & Sheets("Sheet1").Range("E" & i).Address(0, 0)
　　　　　 .Offset(1, 11).Value = "シート１ " & Sheets("Sheet1").Range("F" & i).Address(0, 0)
　　　 End With
　　　 Sh2R = Sh2R + 7
　　Next
End Sub


上と同じですが．．．。
Sub djj2()
　　Dim EndR As Long, i As Long
　　Sh2R = 2
　　EndR = Sheets("Sheet1").Range("A65536").End(xlUp).Row
　　For i = 4 To EndR
　　　 With Sheets("Sheet2")
　　　　　 .Range("A" & Sh2R).Value = "シート１ " & Sheets("Sheet1").Range("A" & i).Address(0, 0) & _
　　　　　　　　　　　　　　　　　　　"行の場合、" & .Range("A" & Sh2R).Address(0, 0) & "のセルを基点にする。"
　　　　　 .Range("F" & Sh2R).Value = "シート１ " & Sheets("Sheet1").Range("B" & i).Address(0, 0)
　　　　　 .Range("F" & Sh2R + 2).Value = "シート１ " & Sheets("Sheet1").Range("C" & i).Address(0, 0)
　　　　　 .Range("I" & Sh2R + 2).Value = "シート１ " & Sheets("Sheet1").Range("D" & i).Address(0, 0)
　　　　　 .Range("L" & Sh2R).Value = "シート１ " & Sheets("Sheet1").Range("E" & i).Address(0, 0)
　　　　　 .Range("L" & Sh2R + 1).Value = "シート１ " & Sheets("Sheet1").Range("F" & i).Address(0, 0)
　　　 End With
　　　 Sh2R = Sh2R + 7
　　Next
End Sub


>100ブロック以上作らなければいけません
同じ物を１００こづつって意味なのか解らなかったんで一応。

Sub djj100()
　　Dim EndR As Long, i As Long
　　Sh2R = 2
　　EndR = Sheets("Sheet1").Range("A65536").End(xlUp).Row
　　If 100 * 7 * (EndR - 3) + 1 - 4 > 65536 Then
　　　 MsgBox "65536行超えます。中止。"
　　　 End
　　End If
　　For i = 4 To EndR
　　　 For ii = 1 To 100
　　　　　 With Sheets("Sheet2").Cells(Sh2R, 1)
　　　　　　　 .Value = "シート１ " & Sheets("Sheet1").Range("A" & i).Address(0, 0) & "行の場合、" _
　　　　　　　　　　　　& .Address(0, 0) & "のセルを基点にする。"
　　　　　　　 .Offset(0, 5).Value = "シート１ " & Sheets("Sheet1").Range("B" & i).Address(0, 0)
　　　　　　　 .Offset(2, 5).Value = "シート１ " & Sheets("Sheet1").Range("C" & i).Address(0, 0)
　　　　　　　 .Offset(2, 8).Value = "シート１ " & Sheets("Sheet1").Range("D" & i).Address(0, 0)
　　　　　　　 .Offset(0, 11).Value = "シート１ " & Sheets("Sheet1").Range("E" & i).Address(0, 0)
　　　　　　　 .Offset(1, 11).Value = "シート１ " & Sheets("Sheet1").Range("F" & i).Address(0, 0)
　　　　　 End With
　　　　　 Sh2R = Sh2R + 7
　　　 Next
　　Next
End Sub
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
13110 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free