「コピー → 行列を入れ替えて貼付け」みたいなマクロ

Question

いつもお世話になっております。

ちょっと前に、こちらで「別シートにデータをコピーするマクロ」
http://bit.ly/1RQlK8M　

という質問で、親切な方にサンプルのマクロを頂きました。
解答して頂いた方、ありがとうございます。

仕事で使うので、早速、使ってみたところ、
現場からカスタムのリクエストが来ました。

一見、簡単そうなカスタムなのですが、、、
今の私の知識では手に負えません。

「Sheet1」に入っているデータをコピーして「Sheet2」に
画像のようにタテ1列に張り付けるというマクロです。

前回とよく似ているのですが、今度は「Sheet2」にタテ方向に貼付ける時の順番
(「Sheet1」を読込む時の順番？)が異なります。

すいませんが、詳しい方、親切な方、前回同様、サンプルのマクロを
貼り付けて頂けないでしょうか？

よろしくお願いします。

※必要としている機能は「Sheet1」、「Sheet2」の画像でわかると思います

※前回のサンプルのマクロは　http://bit.ly/1RQlK8M　にあります。

※前回記載した通り、まだVBA初心者です。理論を説明して頂いても理解出来ないと思います。
すいませんがサンプルの貼り付けでお願いします。

EXCELのバージョンはEXCEL２０１０です。

tom04 · Accepted Answer

＞A1セルに「伝票番号」と記入したいです。要するに行番号の始まりが何行目か？だけのもんだいです。最初の「Sample1」のコードに少し手を加えています。 Sub Sample4() Dim i As Long, j As Long, cnt As Long, wS As Worksheet Set wS = Worksheets("Sheet2") wS.Range("A:A").ClearContents '←Sheet2のA列データを一旦消去// wS.Range("A1") = "伝票番号" 'A1セルも消去しているので「伝票番号」を入力//★ cnt = cnt + 1 '←ここで行番号を「1」に設定しておく//★ With Worksheets("Sheet1") For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row '←2行目～A列最終行まで// For j = 2 To 11 '←B列～K列まで// If .Cells(i, j) <> "" Then cnt = cnt + 1 '←行番号を「1」ずつプラスするので最初は「2」となる//★ wS.Cells(cnt, "A") = .Cells(i, j) '←Sheet2A列「i」行目にSheet1の「i」行「j」列データを代入//★ End If Next j Next i End With End Sub ※　最初の質問が1行目からの表示だったのであのようにしましたが、 1行目に何らかのデータがあるのであれば↓のコードでも大丈夫だと思います。 Sub Sample5() Dim i As Long, j As Long, wS As Worksheet Set wS = Worksheets("Sheet2") wS.Range("A:A").ClearContents wS.Range("A1") = "伝票番号" With Worksheets("Sheet1") For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row For j = 2 To 11 If .Cells(i, j) <> "" Then wS.Cells(Rows.Count, "A").End(xlUp).Offset(1) = .Cells(i, j) End If Next j Next i End With End Sub

tom04 · Answer

質問3については、今までの流れとは全く関係ないのですね？
まぁ～～～それはさておいて・・・

当方がアドバイスできる範囲内でお答えします。

1）～5）に関してですが、メッセージボックスよりもインプットボックスの方が適していると思いますが、
フォントサイズ等の変更ができるかどうか判りません。
自分だと↓の画像のようなテキストボックスとコマンドボタンを配置したユーザーフォームを作成し、
質問にある方法にします。
（ユーザーフォーム作成時にプロパティでフォントサイズ等が設定できるため）

その下準備ができた上での一例です。

まずSheet上にコマンドボタンを配置、コマンドボタンのコードを↓にします。

Private Sub CommandButton1_Click()
    UserForm1.Show
End Sub

次にユーザーフォームのコマンドボタンのコードを↓にします。

Private Sub CommandButton1_Click()
    Dim str As String, c As Range
    If TextBox1 <> "" Then
    str = TextBox1
    Set c = ActiveSheet.Cells.Find(what:=str, LookIn:=xlValues, lookat:=xlWhole)
        Unload Me
        If Not c Is Nothing Then
            c.Select
        Else
            MsgBox "該当データなし"
        End If
    Else
        MsgBox "入力してください"
    End If
End Sub

これで何とかお望み通りの動きになると思います。

※　入力時のフォントサイズにこだわらないのであれば
インプットボックスを使用して、Sheet上のコマンドボタンをクリックで
何とかできると思います。m(_ _)m

tom04 · Answer

続けてお邪魔します。

＞「For j = 2 To 11」 '←B列～K列まで//
とありますので、B列を「B2からB31まで読み込む」と思っていました。

コード内で
＞wS.Cells(cnt, "A") = .Cells(i, j)
のように変数「j」は列番号として使用していますので、
＞For j = 2 To 11
は
2列目～11列目　すなわち　B列～K列まで
というコトになります。

＞For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row 
＞For j = 2 To 11 
の変数のループを見ると「i」の方が先に来ていますので、
2行目の2列目～11列目　→　3行目の2列目～11列目　→　4行目の2列目～11列目・・・
各行を右に向かってループするコードになります。

※　余談ですが
＞For j = 2 To 11 
＞For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row 
のように入れ替わると
B列の2行目～最終行まで　→　C列の2行目～最終行まで・・・
といった具合に下方向にループするコトになります。m(_ _)m

tom04 · Answer

こんばんは！

今回は単純に縦に並べていけば良いのですね？
そうであれば前回の　Sample1　のマクロで大丈夫だと思います。
（Sample1を行った後で昇順に並び替えたのがSample2です。）

※　前回はK列まで限定でした。
列数は関係なく、各行の最終列まで！というコトであれば
↓のコードにしてみてください。
（前回のSample1に少しだけ手を加えています）

Sub Sample3()
Dim i As Long, j As Long, cnt As Long, wS As Worksheet
Dim lastCol As Long '←変数を追加//★
Set wS = Worksheets("Sheet2")
wS.Range("A:A").ClearContents '←Sheet2のA列データを一旦消去//
With Worksheets("Sheet1")
For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row '←2行目～A列最終行まで//
    lastCol = .Cells(i, Columns.Count).End(xlToLeft).Column '←　「i」行の最終列を取得//★
    If lastCol > 1 Then
        For j = 2 To lastCol '←B列～データがある最終列まで//★
            cnt = cnt + 1
            wS.Cells(cnt, "A") = .Cells(i, j)
        Next j
    End If
Next i
End With
End Sub

こんな感じではどうでしょうか？m(_ _)m

「コピー → 行列を入れ替えて貼付け」みたいなマクロ

＞A1セルに「伝票番号」と記入したいです。

質問3については、今までの流れとは全く関係ないのですね？

続けてお邪魔します。

こんばんは！

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング