Excel VBA質問箱 IV

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

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


8637 / 13646 ツリー ←次へ | 前へ→

【32099】8桁の文字を1個ずつ抽出 ぼんぼん 05/12/6(火) 14:54 質問[未読]
【32101】Re:8桁の文字を1個ずつ抽出 Statis 05/12/6(火) 15:08 発言[未読]
【32106】Re:8桁の文字を1個ずつ抽出 ぼんぼん 05/12/6(火) 15:36 発言[未読]
【32108】Re:8桁の文字を1個ずつ抽出 Statis 05/12/6(火) 15:45 発言[未読]
【32112】Re:8桁の文字を1個ずつ抽出 Statis 05/12/6(火) 16:02 回答[未読]
【32111】Re:8桁の文字を1個ずつ抽出 awu 05/12/6(火) 15:56 回答[未読]
【32114】Re:8桁の文字を1個ずつ抽出 awu 05/12/6(火) 16:05 発言[未読]
【32116】Re:8桁の文字を1個ずつ抽出 ぼんぼん 05/12/6(火) 16:08 発言[未読]
【32117】Re:8桁の文字を1個ずつ抽出 Statis 05/12/6(火) 16:21 回答[未読]
【32138】Re:8桁の文字を1個ずつ抽出 bykin 05/12/6(火) 22:38 回答[未読]
【32157】Re:8桁の文字を1個ずつ抽出 ぼんぼん 05/12/7(水) 16:03 お礼[未読]
【32115】Re:8桁の文字を1個ずつ抽出 Kein 05/12/6(火) 16:05 回答[未読]

【32099】8桁の文字を1個ずつ抽出
質問  ぼんぼん  - 05/12/6(火) 14:54 -

引用なし
パスワード
   シート"名簿"の 4列目が 123-4567 という形の郵便番号となってます
この8桁の1文字ずつを、シート"はがき縦"の各セルに表示したいのですが・・

mid や characters を使うんですかね・・・。


'変数の最初の内容を設定する
  Worksheets("名簿").Select
  myRow = 2
  Check = Cells(myRow, 1).Value
  Name1 = Cells(myRow, 2).Value
  Name2 = Cells(myRow, 3).Value

  Add11 = Cells(myRow, 4).Value
  Add12 = Cells(myRow, 5).Value
  Add13 = Cells(myRow, 6).Value
  Add14 = Cells(myRow, 7).Value

  'データがなくなるまで処理を繰り返す
  Do Until Check = "end"
  
    '郵便番号を転記
    Worksheets("はがき縦").Range("E1").Value = Add11
    Worksheets("はがき縦").Range("F1").Value = Add12
    Worksheets("はがき縦").Range("G1").Value = Add13
       ・
       ・
       ・
       ・

【32101】Re:8桁の文字を1個ずつ抽出
発言  Statis  - 05/12/6(火) 15:08 -

引用なし
パスワード
   ▼ぼんぼん さん:こんにちは
>シート"名簿"の 4列目が 123-4567 という形の郵便番号となってます
D列に「123-4567」とあるのですか
それともD列=1,E=2ですか?

>この8桁の1文字ずつを、シート"はがき縦"の各セルに表示したいのですが・・
>
>mid や characters を使うんですかね・・・。
>
>
>'変数の最初の内容を設定する
>  Worksheets("名簿").Select
>  myRow = 2
>  Check = Cells(myRow, 1).Value
>  Name1 = Cells(myRow, 2).Value
>  Name2 = Cells(myRow, 3).Value
Name1、Name2はどこに表示するのですか?

>  Add11 = Cells(myRow, 4).Value
>  Add12 = Cells(myRow, 5).Value
>  Add13 = Cells(myRow, 6).Value
>  Add14 = Cells(myRow, 7).Value
>
>  'データがなくなるまで処理を繰り返す
>  Do Until Check = "end"
>  
>    '郵便番号を転記
>    Worksheets("はがき縦").Range("E1").Value = Add11
>    Worksheets("はがき縦").Range("F1").Value = Add12
>    Worksheets("はがき縦").Range("G1").Value = Add13
>       ・
>       ・
>       ・
>       ・

表示するセルは固定ですか?

【32106】Re:8桁の文字を1個ずつ抽出
発言  ぼんぼん  - 05/12/6(火) 15:36 -

引用なし
パスワード
   早速の返信、ありがとうございます
D列に「123-4567」 です
表示するセルは固定です
Name1、Name2はE9,H9 に表示です(下記には省略していました)


▼Statis さん:
>▼ぼんぼん さん:こんにちは
>>シート"名簿"の 4列目が 123-4567 という形の郵便番号となってます
>D列に「123-4567」とあるのですか
>それともD列=1,E=2ですか?
>
>>この8桁の1文字ずつを、シート"はがき縦"の各セルに表示したいのですが・・
>>
>>mid や characters を使うんですかね・・・。
>>
>>
>>'変数の最初の内容を設定する
>>  Worksheets("名簿").Select
>>  myRow = 2
>>  Check = Cells(myRow, 1).Value
>>  Name1 = Cells(myRow, 2).Value
>>  Name2 = Cells(myRow, 3).Value
>Name1、Name2はどこに表示するのですか?
>
>>  Add11 = Cells(myRow, 4).Value
>>  Add12 = Cells(myRow, 5).Value
>>  Add13 = Cells(myRow, 6).Value
>>  Add14 = Cells(myRow, 7).Value
>>
>>  'データがなくなるまで処理を繰り返す
>>  Do Until Check = "end"
>>  
    '名前を転記
     Worksheets("はがき縦").Range("E9").Value = Name1
     Worksheets("はがき縦").Range("H9").Value = Name2
>>    '郵便番号を転記
>>    Worksheets("はがき縦").Range("E1").Value = Add11
>>    Worksheets("はがき縦").Range("F1").Value = Add12
>>    Worksheets("はがき縦").Range("G1").Value = Add13
>>       ・
>>       ・
>>       ・
>>       ・
>
>表示するセルは固定ですか?

【32108】Re:8桁の文字を1個ずつ抽出
発言  Statis  - 05/12/6(火) 15:45 -

引用なし
パスワード
   こんにちは
D列の郵便番号をどこに表示するのですか?

E1と後がわかりません>

【32111】Re:8桁の文字を1個ずつ抽出
回答  awu  - 05/12/6(火) 15:56 -

引用なし
パスワード
   ちょっと、やろうとしている全体が、いまいち見えませんが・・・・

> シート"名簿"の 4列目が 123-4567 という形の郵便番号となってます
> この8桁の1文字ずつを、シート"はがき縦"の各セルに表示したいのですが・

この内容からは、こんな感じのことと思うのですが、如何でしょうか。

「名簿」シートの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

【32112】Re:8桁の文字を1個ずつ抽出
回答  Statis  - 05/12/6(火) 16:02 -

引用なし
パスワード
   こんにちは
参考までに

Sub Test()
Dim Sh As Worksheet, i As Long, Co As Long

Set Sh = Worksheets("はがき縦")

With Worksheets("名簿")
   For i = 2 To .Range("A65536").End(xlUp).Row
     Sh.Range("E9").Value = .Cells(i, 1).Value
     Sh.Range("H9").Value = .Cells(i, 2).Value
     For Co = 1 To Len(.Cells(i, 4).Value)
       Sh.Range("E1").Offset(, Co - 1).Value = Mid(.Cells(i, 4).Value, Co, 1)
     Next Co
     Sh.PrintOut Preview:=True
   Next i
End With
Set Sh = Nothing
End Sub

【32114】Re:8桁の文字を1個ずつ抽出
発言  awu  - 05/12/6(火) 16:05 -

引用なし
パスワード
   一応、コードを提示したものの、もし、こういうことでしたらVBAを使う
ようなことでもなく、ワークシート関数で、出来る内容と思いますが・・・

【32115】Re:8桁の文字を1個ずつ抽出
回答  Kein  - 05/12/6(火) 16:05 -

引用なし
パスワード
   こんな感じでどうかな ?

Sub 郵便番号転記()
  Sheets("はがき縦").Columns("E:L").ClearContents
  With Sheets("名簿")
   .Range("D2", .Range("D65536").End(xlUp)) _
   .Copy Sheets("はがき縦").Range("E1")
  End With
  With Sheets("はがき縦")
   .Columns(5).Parse "[x][x][x][x][x][x][x][x]"
   .Activate
  End With
End Sub

【32116】Re:8桁の文字を1個ずつ抽出
発言  ぼんぼん  - 05/12/6(火) 16:08 -

引用なし
パスワード
   改めて、全文を掲載します
現時点は、下記の状態で・・・
ADD1 の郵便番号(D列に「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 さん:
>ちょっと、やろうとしている全体が、いまいち見えませんが・・・・
>
>> シート"名簿"の 4列目が 123-4567 という形の郵便番号となってます
>> この8桁の1文字ずつを、シート"はがき縦"の各セルに表示したいのですが・
>
>この内容からは、こんな感じのことと思うのですが、如何でしょうか。
>
>「名簿」シートの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

【32117】Re:8桁の文字を1個ずつ抽出
回答  Statis  - 05/12/6(火) 16:21 -

引用なし
パスワード
   こんにちは

これで如何でしょうか?

Sub Test_1()
Dim Sh As Worksheet, i As Long, Co As Long

Set Sh = Worksheets("はがき縦")

With Worksheets("名簿")
   For i = 2 To .Range("A65536").End(xlUp).Row
     If .Cells(i, 1).Value = "レ" Then
      Sh.Range("E9,H9,E4,F5,G6,E1:J1").ClearContents
      Sh.Range("E9").Value = .Cells(i, 1).Value
      Sh.Range("H9").Value = .Cells(i, 2).Value
      Sh.Range("E4").Value = .Cells(i, 5).Value
      Sh.Range("F5").Value = .Cells(i, 6).Value
      Sh.Range("G6").Value = .Cells(i, 7).Value
      For Co = 1 To Len(.Cells(i, 4).Value)
        Sh.Range("E1").Offset(, Co - 1).Value = Mid(.Cells(i, 4).Value, Co, 1)
      Next Co
      
      Sh.PrintOut Preview:=True
     End If
   Next i
End With
Set Sh = Nothing
End Sub

【32138】Re:8桁の文字を1個ずつ抽出
回答  bykin  - 05/12/6(火) 22:38 -

引用なし
パスワード
   こんばんわ。

差込印刷したいってことやね?
こういうのはワークシート関数と組み合わせたら簡単になるんですわ。

↓こんなんでどーでっか?

【名簿シートの事前準備】
1.A列に1列挿入する。
2.A2から最終データ行まで 1,2,3,4・・・n と、連続データ(数値)を入れる。

【はがきシートの事前準備】
1.検索値用のセルを用意(今回はAA1)し、数値の1を入れておく。
2.E1に =MID(VLOOKUP($AA$1,名簿!$A:$H,5),COLUMN(A1),1)
  と入れ、L1までコピーする。
3.住所氏名のセルに数式を入れる。
  E4:=VLOOKUP($AA$1,名簿!$A:$H,6)
  F5:=VLOOKUP($AA$1,名簿!$A:$H,7)
  G6:=VLOOKUP($AA$1,名簿!$A:$H,8)
  F9:=VLOOKUP($AA$1,名簿!$A:$H,3)
  H9:=VLOOKUP($AA$1,名簿!$A:$H,4)
4.印刷範囲をはがき部分のみにする。(AA1は範囲外とする)
  (対象範囲を選択して、メニューの[ファイル]-[印刷範囲]-[印刷範囲の設定]を実行)

【マクロコード】
Sub test()
  Dim LastRow As Long
  Dim i As Long
  
  With Worksheets("名簿")
    LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    For i = 2 To LastRow
      If .Cells(i, 2).Value = "レ" Then
        Worksheets("はがき縦").Range("AA1").Value = .Cells(i, 1).Value
        Worksheets("はがき縦").PrintOut
      End If
    Next
  End With
End Sub

郵便番号のハイフンが不要なんやったら、I1:L1を切り取って
H1:K1に貼り付けてください。
それと、名簿シートのendという文字列の入ってるセルは不要です。

試してみてな。
ほな。

【32157】Re:8桁の文字を1個ずつ抽出
お礼  ぼんぼん  - 05/12/7(水) 16:03 -

引用なし
パスワード
   みなさま ありがとうございました
もろもろのご意見参考に
 再トライしてみます。^^

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