Excel VBA質問箱 IV

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

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


69 / 13171 ツリー ←次へ | 前へ→

【79788】縦並びのデータを横並びにしたい muco 18/4/13(金) 11:12 質問[未読]

【79791】Re:縦並びのデータを横並びにしたい muco 18/4/13(金) 11:57 発言[未読]
【79792】Re:縦並びのデータを横並びにしたい よろずや 18/4/13(金) 17:13 回答[未読]
【79793】Re:縦並びのデータを横並びにしたい よろずや 18/4/13(金) 17:17 回答[未読]
【79798】Re:縦並びのデータを横並びにしたい muco 18/4/16(月) 11:35 お礼[未読]

【79791】Re:縦並びのデータを横並びにしたい
発言  muco  - 18/4/13(金) 11:57 -

引用なし
パスワード
   >▼よろずや さん:
横並びにするプログラムもできておりません。
そこからご教授いただければと思います。宜しくお願い致します。

【79792】Re:縦並びのデータを横並びにしたい
回答  よろずや  - 18/4/13(金) 17:13 -

引用なし
パスワード
   まずは、Find、Copy バージョン(副作用あり)
Sub Macro2()
Const FirstRow = 1
Const SourceCol = 1
Const TargetRow = 1
Const FirstCol = 4
Dim SourceRow As Long
Dim TargetCol As Long
Dim FoundCell As Range
  TargetCol = FirstCol - 2
  For SourceRow = FirstRow To Cells(Rows.Count, SourceCol).End(xlUp).Row
    ' Findメソッドバージョン
    Set FoundCell = Range(Cells(TargetRow, FirstCol), Cells(TargetRow, TargetCol)) _
      .Find(What:=Cells(SourceRow, SourceCol).Value, LookIn:=xlValues, LookAt:=xlWhole)
    If FoundCell Is Nothing Then
      TargetCol = TargetCol + 2
      ' Copyバージョン
      Cells(SourceRow, SourceCol).Resize(1, 2).Copy _
        Destination:=Cells(TargetRow, TargetCol).Resize(1, 2)
    Else
      ' Copyバージョン
      Cells(SourceRow, SourceCol + 1).Copy
      FoundCell.Offset(0, 1).PasteSpecial Operation:=xlAdd
      Application.CutCopyMode = False
    End If
  Next SourceRow
End Sub

【79793】Re:縦並びのデータを横並びにしたい
回答  よろずや  - 18/4/13(金) 17:17 -

引用なし
パスワード
   副作用のないバージョン
Sub Macro3()
Const FirstRow = 1
Const SourceCol = 1
Const TargetRow = 1
Const FirstCol = 4
Dim SourceRow As Long
Dim TargetCol As Long
Dim FoundCell As Range
Dim SearchCol As Long
  TargetCol = FirstCol - 2
  For SourceRow = FirstRow To Cells(Rows.Count, SourceCol).End(xlUp).Row
    ' 地味に探すバージョン
    Set FoundCell = Nothing
    For SearchCol = FirstCol To TargetCol Step 2
      If Cells(TargetRow, SearchCol).Value = Cells(SourceRow, SourceCol).Value Then
        Set FoundCell = Cells(TargetRow, SearchCol + 1)
        Exit For
      End If
    Next SearchCol
    If FoundCell Is Nothing Then
      TargetCol = TargetCol + 2
      ' 2値代入バージョン
      Cells(TargetRow, TargetCol).Resize(1, 2).Value = Cells(SourceRow, SourceCol).Resize(1, 2).Value
    Else
      ' 値加算バージョン
      FoundCell.Value = FoundCell.Value + Cells(SourceRow, SourceCol + 1).Value
    End If
  Next SourceRow
End Sub

【79798】Re:縦並びのデータを横並びにしたい
お礼  muco  - 18/4/16(月) 11:35 -

引用なし
パスワード
   ご回答ありがとうございます。
お返事が遅くなり申し訳ございません。
これからコードの勉強を致します。

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