Excel VBA質問箱 IV

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

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


8326 / 76732 ←次へ | 前へ→

【73981】Re:転記方法
発言  UO3  - 13/3/30(土) 12:39 -

引用なし
パスワード
   ▼おく さん:

こんにちは
アップされた構成がSample1、別案としてSample2 です。

Sub sample1()
  Dim i As Long
  Dim a As Long
  Dim b As Long
  Dim ii As Long
  
  i = 1
  a = 1
  b = 3
  ii = 1
  
  Do Until Cells(i, 1) = ""
    If a <> Cells(i, 1).Value Then
      ii = 1
      b = b + 1
    End If
    Cells(ii, b).Value = Cells(i, 2).Value
    a = Cells(i, 1).Value
    i = i + 1
    ii = ii + 1
  Loop
  
End Sub

Sub Sample2()
  Dim c As Range
  Dim x As Long
  Dim y As Long
  Dim old As Variant
  
  x = 3
  y = 1
  old = Range("A1").Value
  Columns("C").ClearContents
  
  For Each c In Range("A1", Range("A" & Rows.Count).End(xlUp))
    If c.Value <> old Then
      x = x + 1
      y = 1
      Columns(x).ClearContents
    End If
    Cells(y, x).Value = c.Offset(, 1).Value
    old = c.Value
    y = y + 1
  Next
  
End Sub
234 hits

【73980】転記方法 おく 13/3/30(土) 11:55 質問
【73981】Re:転記方法 UO3 13/3/30(土) 12:39 発言
【73982】Re:転記方法 おく 13/3/30(土) 12:51 お礼

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