Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 10 Home : Excel 2016)
繰り返し処理で簡潔にするにはどうしたらよいでしょうか
投稿日時: 20/07/15 02:34:54
投稿者: UUU

シート1にシート2のセルを配列を変えてコピーしたくて以下のように記述しました
一応動いているようですが、明らかに繰り返し処理で済むだろうという箇所が力技でしかできません
 
        ws2.Cells(n, 1).Value = ws1.Cells(i, 1).Value
        ws2.Cells(n, 4).Value = ws1.Cells(i, S).Value
        n = n + 1
        S = S + 1
 
この部分です。もう少し簡潔に書くにはどのようにしたらよいでしょうか?
実験なので短くしていますが
S = S + 1 はあと20回は繰り返す必要があり
ws2.Cells(n, 4).Value はws2.Cells(n, 20).Value  程度までは増えそうです
ws1の行が変わっても
ws2.Cells(n, 1).Value = ws1.Cells(i, 1).Value
は固定して入力したいです
 
**************************
Sub テスト()
    Dim i As Long
    Dim n As Long
    Dim m As Long
    Dim ws1 As Worksheet, Dim ws2 As Worksheet
     
    Set ws1 = Worksheets("コピー元")
    Set ws2 = Worksheets("コピー先")
 
    n = ws2.Cells(Rows.Count, "A").End(xlUp).Row
    n = n + 1
 
    For i = 2 To ws1.Cells(Rows.Count, "A").End(xlUp).Row
    S = 4
        ws2.Cells(n, 1).Value = ws1.Cells(i, 1).Value
        ws2.Cells(n, 4).Value = ws1.Cells(i, S).Value
        n = n + 1
        S = S + 1
        ws2.Cells(n, 1).Value = ws1.Cells(i, 1).Value
        ws2.Cells(n, 4).Value = ws1.Cells(i, S).Value
        n = n + 1
        S = S + 1
        ws2.Cells(n, 1).Value = ws1.Cells(i, 1).Value
        ws2.Cells(n, 4).Value = ws1.Cells(i, S).Value
        n = n + 1
        S = S + 1
    Next i
 End Sub

回答
投稿日時: 20/07/15 05:51:59
投稿者: takesi

 
 
 

   n = ws2.Cells(Rows.Count, "A").End(xlUp).Row + 1
    S = 4
    kaisu = 20 '20行繰り返し(ws1の対象列数かな?)
    
    For i = 2 To ws1.Cells(Rows.Count, "A").End(xlUp).Row
        For j = 0 To kaisu - 1
            ws2.Cells(n, 1).Offset(j, 0).Value = ws1.Cells(i, 1).Value
            ws2.Cells(n, 4).Offset(j, 0).Value = ws1.Cells(i, S + j).Value
        Next
        n = n + kaisu
    Next i

回答
投稿日時: 20/07/15 22:41:37
投稿者: WinArrow
投稿者のウェブサイトに移動

確認です。

引用:

シート1にシート2のセルを配列を変えてコピーしたくて以下のように記述しました
一応動いているようですが、明らかに繰り返し処理で済むだろうという箇所が力技でしかできません

 
>一応動いている
と書いてあるので、書き間違いなのかな?と思っていますが、
>シート1にシート2のセルを
のシート1とシート2が逆ではないでしょうか?
 
転送元シート側はA列の2行目からのデータを
転送先は、D列の既存のデータの次の行以降に
複写したいということでしょうか?
 
 
 

回答
投稿日時: 20/07/15 22:46:09
投稿者: WinArrow
投稿者のウェブサイトに移動

追加レス、
>Sを20回繰り返し
列方向の繰り返しも必要ないと考えます。

回答
投稿日時: 20/07/15 23:06:15
投稿者: WinArrow
投稿者のウェブサイトに移動

確認・続き
 
複写するのは、A列とD列〜複数列ということでしょうか?
(B列とC列は複写対象外)

回答
投稿日時: 20/07/15 23:24:06
投稿者: WinArrow
投稿者のウェブサイトに移動

すいませんね・・・
もう一つ、確認です。
 
> ws2.Cells(n, 4).Value = ws1.Cells(i, S).Value
このコードが3回書かれています。
Sは、その都度、変化しているので、つまり、転送元側の列は
D,E,Fと変わりますが。
転送先側は、常に4(D)列ということでよいのですか?
 

回答
投稿日時: 20/07/15 23:44:22
投稿者: WinArrow
投稿者のウェブサイトに移動

参考コード
前提
 転送元シートのA列とD列より右へ複数列(但し、1行目を除きすべての行)を
転送先シートの既存データの下の行に複写する
  
※ループなし
  
Sub 転記()
Const 転送元 As String = "Sheet1"
 Const 転送先 As String = "Sheet2"
 Dim ws1 As Worksheet, ws2 As Worksheet
 Dim Row2 As Long, Rng1 As Range
   
 Set ws1 = Worksheets(転送元)
Set ws2 = Worksheets(転送先)
Set Rng1 = ws1.UsedRange.Offset(1)
   
 With ws2
     Row2 = .Range("A" & .Rows.Count).End(xlUp).Row + 1
     .Cells(Row2, "A").Resize(Rng1.Rows.Count - 1, 1).Value = Rng1.Columns(1).Value
     .Cells(Row2, "D").Resize(Rng1.Rows.Count - 1, Rng1.Columns.Count - 3).Value = Rng1.Offset(, 3).Value
 End With

回答
投稿日時: 20/07/16 21:25:16
投稿者: simple

単純にこういうことでよいのではないでしょうか。

Sub テスト()
    Dim n As Long
    Dim i As Long
    Dim k As Long

    Dim ws1 As Worksheet
    Dim ws2 As Worksheet

    Set ws1 = Worksheets("コピー元")
    Set ws2 = Worksheets("コピー先")

    n = ws2.Cells(Rows.Count, "A").End(xlUp).Row + 1

    For i = 2 To ws1.Cells(Rows.Count, "A").End(xlUp).Row
        For k = 4 To 24
            ws2.Cells(n, 1).Value = ws1.Cells(i, 1).Value
            ws2.Cells(n, 4).Value = ws1.Cells(i, k).Value
            n = n + 1
        Next
    Next
End Sub

回答
投稿日時: 20/07/16 22:19:01
投稿者: WinArrow
投稿者のウェブサイトに移動

疑問点

引用:

       For k = 4 To 24
            ws2.Cells(n, 1).Value = ws1.Cells(i, 1).Value
            ws2.Cells(n, 4).Value = ws1.Cells(i, k).Value

 
なぜ、20回のルールが必要なんでしょう?
> ws2.Cells(n, 1).Value = ws1.Cells(i, 1).Value
は、同じことを20回も繰り返す必要はない
 
> ws2.Cells(n, 4).Value = ws1.Cells(i, k).Value
は、複写先は、常にD列セルだから、20回繰り返すことはなく、
最も右端セルだけ(つまり、1回だけ)実行すればよい。

回答
投稿日時: 20/07/17 07:40:24
投稿者: simple

データベースの世界でいうところの、
横持ちから縦持ちへの変換ということではないかと思いました。
 
「テーブルの横持ちと縦持ちの使い分けと変換」
https://mathwords.net/yokomotitatemoti

回答
投稿日時: 20/07/17 09:36:30
投稿者: WinArrow
投稿者のウェブサイトに移動

simple さんの引用:
データベースの世界でいうところの、
横持ちから縦持ちへの変換ということではないかと思いました。
 
「テーブルの横持ちと縦持ちの使い分けと変換」
https://mathwords.net/yokomotitatemoti

 
なうほど・・・・・そういうことか?
 
変数:n
が、目に入りませんでした。

回答
投稿日時: 20/07/17 17:42:21
投稿者: WinArrow
投稿者のウェブサイトに移動

行列変換お使った参考コード
 
Sub 転記()
Const 転送元 As String = "Sheet1"
Const 転送先 As String = "Sheet2"
Dim ws1 As Worksheet, ws2 As Worksheet
Dim Row2 As Long, Rng1 As Range, Row1 As Long
     
Set ws1 = Worksheets(転送元)
Set ws2 = Worksheets(転送先)
Set Rng1 = ws1.UsedRange
     
With ws2
    For Row1 = Rng1.Row + 1 To Rng1.Row + Rng1.Rows.Count
        Row2 = .Range("A" & .Rows.Count).End(xlUp).Row + 1
        .Cells(Row2, "A").Resize(Rng1.Columns.Count - 3).Value = Rng1.Cells(Row1, "A").Value
        Rng1.Offset(, 3).Rows(Row1).Copy
        .Cells(Row2, "D").Resize(Rng1.Columns.Count - 3).PasteSpecial Paste:=xlPasteValues, Transpose:=True
        Application.CutCopyMode = False
    Next
End With
End Sub

トピックに返信