| |
改めて、全文を掲載します
現時点は、下記の状態で・・・
ADD1 の郵便番号（Ｄ列に「123-4567」）を分割して
シート"はがき縦"の
E1,F1,G1,H1,I1,J1 に配列したいのです
Sub 宛名印刷はがき縦() 'はがき縦
Dim myRow As Integer
Dim Check As String
Dim Name1 As String
Dim Name2 As String
Dim Add1 As String
Dim Add2 As String
Dim Add3 As String
Dim Add4 As String
'変数の最初の内容を設定する
Worksheets("名簿").Select
myRow = 2
Check = Cells(myRow, 1).Value
Name1 = Cells(myRow, 2).Value
Name2 = Cells(myRow, 3).Value
Add1 = Cells(myRow, 4).Value
Add2 = Cells(myRow, 5).Value
Add3 = Cells(myRow, 6).Value
Add4 = Cells(myRow, 7).Value
'データがなくなるまで処理を繰り返す
Do Until Check = "end"
'名前を転記
Worksheets("はがき縦").Range("F9").Value = Name1
Worksheets("はがき縦").Range("H9").Value = Name2
'住所を転記
Worksheets("はがき縦").Range("E1").Value = Add1
Worksheets("はがき縦").Range("E4").Value = Add2
Worksheets("はがき縦").Range("F5").Value = Add3
Worksheets("はがき縦").Range("G6").Value = Add4
If Check = "レ" Then
'印刷
Sheets("はがき縦").Select
ActiveWindow.SelectedSheets.PrintOut copies:=1, collate:=True
End If
'変数を更新（1行）
Worksheets("名簿").Select
myRow = myRow + 1
Check = Cells(myRow, 1).Value
Name1 = Cells(myRow, 2).Value
Name2 = Cells(myRow, 3).Value
Add1 = Cells(myRow, 4).Value
Add2 = Cells(myRow, 5).Value
Add3 = Cells(myRow, 6).Value
Add4 = Cells(myRow, 7).Value
Loop
End Sub
質問が前後して、すんません。
▼awu さん：
>ちょっと、やろうとしている全体が、いまいち見えませんが・・・・
>
>> シート"名簿"の ４列目が 123-4567 という形の郵便番号となってます
>> この８桁の１文字ずつを、シート"はがき縦"の各セルに表示したいのですが・
>
>この内容からは、こんな感じのことと思うのですが、如何でしょうか。
>
>「名簿」シートのD列2行目から下にある郵便番号を1文字ずつ「はがき縦」シートの
>同行のE列から順に右へ書き出す と解釈します。
>
>Sub Div_PostNo()
>Dim Rng As Range
>Dim N As Integer
>Worksheets("名簿").Activate
>With Worksheets("はがき縦")
> For Each Rng In Range("D2", Range("D65536").End(xlUp))
> For N = 1 To 8
> .Cells(Rng.Row, Rng.Column + N).Value = _
> Mid(Trim(Rng.Value), N, 1)
> Next N
> Next Rng
>End With
>End Sub
|
|
ぼんぼん
- 05/12/6(火) 16:08 -
