Excel VBA質問箱 IV

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

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


73152 / 76738 ←次へ | 前へ→

【8069】Re:Arrayへのデータ追加について
お礼  kawata  - 03/9/29(月) 11:35 -

引用なし
パスワード
   kawataです、よろしくお願いします。

ichinoseさん、bikynさん、どうもありがとうございました、
どうにかこうにか、やりたいことの形が見えてきました。

<データ>
   a   b   c
1  a001     a002    a003
2  b001     b002    c001
3  c002      b003    c003
4  a004  b004    c004
(以下、続く)

Sub testz()
  Dim MyArray As Variant
  Dim MyArray1() As Variant
  Dim MyArray2() As Variant
  Dim MyArray3() As Variant
  Dim m As Long, n As Long
  Dim j1 As Long, j2 As Long, j3 As Long
 
  With Sheets("Sheet2")
    e_row = .UsedRange.Rows.Count
    MyArray = .Range("a1:c" & e_row).Value
    j1 = 1: j2 = 1: j3 = 1
    For n = 1 To e_row
      For m = 1 To 3
        chk = Left(MyArray(n, m), 1)
        Select Case chk
          Case "a"
            ReDim Preserve MyArray1(1 To 1, 1 To j1)
            MyArray1(1, j1) = MyArray(n, m)
            j1 = j1 + 1
          Case "b"
            ReDim Preserve MyArray2(1 To 1, 1 To j2)
            MyArray2(1, j2) = MyArray(n, m)
            j2 = j2 + 1
          Case "c"
            ReDim Preserve MyArray3(1 To 1, 1 To j3)
            MyArray3(1, j3) = MyArray(n, m)
            j3 = j3 + 1
        End Select
        j = j + 1
      Next
    Next
    .Range("d1").Resize(, UBound(MyArray1, 2)).Value = MyArray1
    .Range("d2").Resize(, UBound(MyArray2, 2)).Value = MyArray2
    .Range("d3").Resize(, UBound(MyArray3, 2)).Value = MyArray3
  End With
End Sub

まだまだスッキリしたコードとはいえませんが、とにかく配列を習得したいが
ためにということで数をこなしていきたいと思います。(^^;。

ありがとうございました!!。
またよろしくお願いします。
0 hits

【8037】Arrayへのデータ追加について kawata 03/9/27(土) 9:43 質問
【8042】Re:Arrayへのデータ追加について ichinose 03/9/27(土) 17:08 発言
【8044】Re:Arrayへのデータ追加について kawata 03/9/27(土) 17:23 お礼
【8047】Re:Arrayへのデータ追加について bykin 03/9/27(土) 20:36 回答
【8060】Re:Arrayへのデータ追加について kawata 03/9/29(月) 8:31 お礼
【8069】Re:Arrayへのデータ追加について kawata 03/9/29(月) 11:35 お礼

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