Excel VBA質問箱 IV

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

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


13108 / 13644 ツリー ←次へ | 前へ→

【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 = "シート1 " & Sheets("Sheet1").Range("A" & i).Address(0, 0) & "行の場合、" _
          & .Address(0, 0) & "のセルを基点にする。"
      .Offset(0, 5).Value = "シート1 " & Sheets("Sheet1").Range("B" & i).Address(0, 0)
      .Offset(2, 5).Value = "シート1 " & Sheets("Sheet1").Range("C" & i).Address(0, 0)
      .Offset(2, 8).Value = "シート1 " & Sheets("Sheet1").Range("D" & i).Address(0, 0)
      .Offset(0, 11).Value = "シート1 " & Sheets("Sheet1").Range("E" & i).Address(0, 0)
      .Offset(1, 11).Value = "シート1 " & 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 = "シート1 " & Sheets("Sheet1").Range("A" & i).Address(0, 0) & _
                   "行の場合、" & .Range("A" & Sh2R).Address(0, 0) & "のセルを基点にする。"
      .Range("F" & Sh2R).Value = "シート1 " & Sheets("Sheet1").Range("B" & i).Address(0, 0)
      .Range("F" & Sh2R + 2).Value = "シート1 " & Sheets("Sheet1").Range("C" & i).Address(0, 0)
      .Range("I" & Sh2R + 2).Value = "シート1 " & Sheets("Sheet1").Range("D" & i).Address(0, 0)
      .Range("L" & Sh2R).Value = "シート1 " & Sheets("Sheet1").Range("E" & i).Address(0, 0)
      .Range("L" & Sh2R + 1).Value = "シート1 " & Sheets("Sheet1").Range("F" & i).Address(0, 0)
    End With
    Sh2R = Sh2R + 7
  Next
End Sub


>100ブロック以上作らなければいけません
同じ物を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 = "シート1 " & Sheets("Sheet1").Range("A" & i).Address(0, 0) & "行の場合、" _
            & .Address(0, 0) & "のセルを基点にする。"
        .Offset(0, 5).Value = "シート1 " & Sheets("Sheet1").Range("B" & i).Address(0, 0)
        .Offset(2, 5).Value = "シート1 " & Sheets("Sheet1").Range("C" & i).Address(0, 0)
        .Offset(2, 8).Value = "シート1 " & Sheets("Sheet1").Range("D" & i).Address(0, 0)
        .Offset(0, 11).Value = "シート1 " & Sheets("Sheet1").Range("E" & i).Address(0, 0)
        .Offset(1, 11).Value = "シート1 " & Sheets("Sheet1").Range("F" & i).Address(0, 0)
      End With
      Sh2R = Sh2R + 7
    Next
  Next
End Sub

13108 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free