エクセルVBAで別シートへ情報を加工して移したい

質問

すみません、本当に困ってます。
皆様お忙しいとは存じますが、何卒お力添え頂けませんでしょうか。

エクセルVBAは完全に素人です。
AのシートからBのシートへ欲しい情報だけを抜き出して
一覧表にしていきたいのですが、できないでいます。

いろいろ調べながら現在、AのシートからBのシートへ
情報を移動させ、最後にAのシートをクリアするとこまでできたのですが、
そこから行き詰りました。

やり方としては、Aシートが入力シートとなっています。
Aシートには、届いたメール本文をテキストでそのままペーストします。
そうしますと、AシートのA列には、
＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
ご利用ID　　　：99
営業形態　　　：店舗
事業所名　　　：サンプル所
＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
という文字列が入ります。

このAシートに入った情報をBシートのA列に
＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
99
店舗
サンプル所
＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
という形に加工して貼り付けたいです。

一応、以下のようにやっているのですが、どうしたら良いか
分かりません。

Private Sub CommandButton1_Click()
'コピー用の項目を作成

'一覧に追加して下へ
Worksheets("Bシート").Range("1:1").Insert shift:=xlShiftDown

'IDを追加
Worksheets("Bシート").Range("A1").Value = Application.Transpose(Worksheets("Aシート").Range("A1"))

'営業形態を追加
Worksheets("Bシート").Range("A2").Value = Application.Transpose(Worksheets("Aシート").Range("A2"))

申し訳ございませんが、お力添え頂けませんでしょうか。

何卒宜しくお願い申し上げます。

回答No.2

eden3616 · ベストアンサー

ご提示の処理でBシートの1行目を挿入し、
IDや営業形態で1行目と2行目に書き出しという処理を
なぜ必要なのか辻褄が合わないように思います。

ので、以下のように解釈しています。
(1)Bシートの1行目を挿入
(2)AシートのA列1行目～○行目（3行固定？）を加工
(3)行列を入替でBシートの1行目のA1、B1、C1セル・・・へ出力

間違っていたら申し訳ありません。

ただし、
エクセル2007では、Bシートの列数の最大が16384列までですので、
Aシートの行数が16384行までの場合に対応します。

■VBAコード

Private Sub CommandButton1_Click()
'型宣言
Dim i As Long
Dim myStr As String

'Bシートの1行目をシフトダウン
Worksheets("Bシート").Range("1:1").Insert shift:=xlShiftDown

'AシートのA列末尾まで繰り返し処理
For i = 1 To Worksheets("Aシート").Cells(Rows.Count, "A").End(xlUp).Row
　　'AシートA列の値を変数に格納
　　myStr = Worksheets("Aシート").Cells(i, "A")
　　'変数から"："を検索して、右側を抜出して格納し直し
　　myStr = Right(myStr, Len(myStr) - InStr(1, myStr, "："))
　　'Bシートの1行目に変数を出力
　　Worksheets("Bシート").Cells(1, i) = myStr
Next i

'Aシートの値削除
With Worksheets("Aシート")
　　.Range(.Cells(1, "A"), .Cells(Rows.Count, "A").End(xlUp)).ClearContents
End With
End Sub

■追記

Right関数は「指定した文字列」を「指定した文字数」から「文字数」分だけ抜き出すため、
Len関数と組み合わせて使う必要がありますので、No1さんのコードでは求める結果にならないかと。

お礼

eden3616様

ありがとうございます。今、回答拝見させて頂きまして、
取り急ぎ御礼申し上げます。
あと、すみません！焦って書いていたため、ご指摘通り
BシートのA1,B1,C1・・・と横に展開されるのが
正しいです。
お気づき頂きましてありがとうございます。
まだ試せてないのですが、できそうな感じがします！
またご連絡させて頂きます。よろしくお願い致します。

回答No.1

usami33

判りやすい様に、一行、位置処理で書いてます。

必ず１０文字目以降なら
1 2 3 45 6 7 8 9
ご利用ID　　　：99
Dim str1 As String
Dim str2 As String

str1 = Application.Transpose(Worksheets("Aシート").Range("A1"))
str2 = RightB(str1, 10) ' 10文字目から右を切り出す
Worksheets("Bシート").Range("A1").Value = str2

「：」を探すなら
Dim N As Long
Dim str1 As String
Dim str2 As String

str1 = Application.Transpose(Worksheets("Aシート").Range("A1"))
N = InStr(str1, "：")
str2 = RightB(str1, N+1) ' 10文字目から右を切り出す
Worksheets("Bシート").Range("A1").Value = str2

お礼

usami33様
ご回答ありがとうございます！
焦って書いていたためBシートへはA1,B1,C1と展開されるのが
正しかったのですが、改変すればできるかもしれないと
思いました。
まだ試せてないのですが、本当にありがたく、
心より御礼申し上げます。