Excel VBA質問箱 IV

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

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


9540 / 13644 ツリー ←次へ | 前へ→

【26669】セルの値の移動 懐園剣 05/7/13(水) 17:17 質問[未読]
【26676】Re:セルの値の移動 かみちゃん 05/7/13(水) 22:17 回答[未読]
【26677】Re:セルの値の移動 かみちゃん 05/7/13(水) 22:40 回答[未読]
【26709】Re:セルの値の移動 懐園剣 05/7/14(木) 15:39 質問[未読]
【26720】Re:セルの値の移動 かみちゃん 05/7/14(木) 22:56 発言[未読]
【26803】Re:セルの値の移動 懐園剣 05/7/18(月) 20:48 お礼[未読]
【26780】Re:セルの値の移動 Hirofumi 05/7/17(日) 21:16 回答[未読]
【26804】Re:セルの値の移動 懐園剣 05/7/18(月) 20:50 お礼[未読]

【26669】セルの値の移動
質問  懐園剣  - 05/7/13(水) 17:17 -

引用なし
パスワード
   教えてください。

下記のような表があります。

ID                         項目1 項目2 項目3・・
100001,100011,100012,100021,100022 11111 22222 33333・・
100001,100011,100012           11112 22225 33338・・
100001,100011,100012,100021      11113 22229 33345・・
          ・            ・   ・   ・
          ・            ・   ・   ・
          ・            ・   ・   ・

この表の1列目の値が”カンマ”で区切ってあります。カンマの数は決まっていません。”カンマ”の次の値を列の次のセルに入れてあげて、項目1以降の値をそのままIDの行に反映させてあげたいのですが・・。

(こんな感じです!!)
ID   項目1 項目2 項目3・・
100001 11111 22222 33333・・
100011 11111 22222 33333・・
100012 11111 22222 33333・・
100021 11111 22222 33333・・
100022 11111 22222 33333・・
100001 11112 22225 33338・・
100011 11112 22225 33338・・
100012 11112 22225 33338・・
100001 11113 22229 33345・・
 ・   ・   ・   ・
どうか教えてください。お願いします。

【26676】Re:セルの値の移動
回答  かみちゃん  - 05/7/13(水) 22:17 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>この表の1列目の値が”カンマ”で区切ってあります。カンマの数は決まっていません。
>”カンマ”の次の値を列の次のセルに入れてあげて、項目1以降の値をそのままIDの行に反映させてあげたい

まず、質問の仕方がすばらしいと感じました。
処理前のデータと処理後の期待している結果がハッキリわかりました。

そこで、以下のようなコードでできると思います。
元のシートをアクティブにすると、Sheet2に結果を出力します。
なお、元のシートは、IDがA列、項目1からはB列以降に入れてあるものとして、
B列からIV列までのデータをコピーするという方法を使っています。

Option Explicit
Sub Macro1()
 Dim RowNo As Long
 Dim RowNo2 As Long
 Dim strID As Variant
 Dim i As Integer
 
 RowNo = 2
 RowNo2 = 2
 Do Until Cells(RowNo, 1).Value = ""
  strID = Split(Cells(RowNo, 1).Value, ",")
  For i = 0 To UBound(strID)
   'Sheet2に結果を出力する
   With Sheets("Sheet2").Cells(RowNo2, 1)
    .Value = "'" & strID(i)
    Range("B" & RowNo & ":" & "IV" & RowNo).Copy Destination:=.Offset(, 1)
   End With
   RowNo2 = RowNo2 + 1
  Next
  RowNo = RowNo + 1
 Loop
 MsgBox "処理を終了しました。"
End Sub

【26677】Re:セルの値の移動
回答  かみちゃん  - 05/7/13(水) 22:40 -

引用なし
パスワード
   こんにちは。かみちゃん です。

ちょっと、訂正します。間違いではないですが・・・

>    Range("B" & RowNo & ":" & "IV" & RowNo).Copy Destination:=.Offset(, 1)

    Range(Cells(RowNo, 2), Cells(RowNo, 256)).Copy Destination:=.Offset(, 1)

【26709】Re:セルの値の移動
質問  懐園剣  - 05/7/14(木) 15:39 -

引用なし
パスワード
   かみちゃん さんへ
ありがとうございます。できました。

もうひとつ質問してもいいですか?
できれば項目名もsheet2の1行目に反映させてあげたいのですが、
どうしたらよいのでしょうか?

重ね重ねで申し訳ありませんがよろしくお願いします。

【26720】Re:セルの値の移動
発言  かみちゃん  - 05/7/14(木) 22:56 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>できれば項目名もsheet2の1行目に反映させてあげたいのですが、

「コピー」「貼り付け」を「マクロの記録」で記録してみてはいかがでしょうか?
または、ヘルプ情報で、「Range オブジェクトの Copy メソッド」を調べてみてください。

【26780】Re:セルの値の移動
回答  Hirofumi  - 05/7/17(日) 21:16 -

引用なし
パスワード
   解決しちゃった様で?

Option Explicit

Public Sub DataConversion()

  '項目列数を設定(項目1、項目2、項目3・・)
  Const clngColumns As Long = 3
  
  Dim i As Long
  Dim lngRows As Long
  Dim lngCount As Long
  Dim rngList As Range
  Dim vntID As Variant
  Dim vntItems As Variant
  Dim rngResult As Range
  Dim vntResult As Variant
  Dim lngRow As Long
  Dim strProm As String
  
'  Application.ScreenUpdating = False
  
  'データのシートのList先頭セル位置を指定(ID項目の列見出しの位置)
  Set rngList = Worksheets("Sheet1").Cells(1, "A")
  With rngList
    'データ行数を取得
    lngRows = .Offset(65536 - .Row).End(xlUp).Row - .Row
    If lngRows <= 0 Then
      strProm = "データが有りません"
      GoTo Wayout
    End If
    'ID列のデータを配列に取得
    vntID = .Offset(1).Resize(lngRows).Value
  End With
  
  '出力シートの出力先頭セル位置を指定
  Set rngResult = Worksheets("Sheet2").Cells(1, "A")
  '出力シートの出力先頭に列見だしを出力
  rngList.Resize(, clngColumns + 1).Copy Destination:=rngResult
  
  '出力行位置の初期値
  lngRow = 1
  'データ行全てに就いて繰り返し
  For i = 1 To lngRows
    'IDを配列にカンマ区切りで分割
    vntResult = Split(vntID(i, 1), ",")
    'ID数を取得
    lngCount = UBound(vntResult) + 1
    '出力シートに就いて
    With rngResult
      '出力範囲の書式を文字列に設定
'      .Offset(lngRow).Resize(lngCount, clngColumns + 1).NumberFormatLocal = "@"
      'IDを出力
      .Offset(lngRow).Resize(lngCount).Value _
          = Application.Transpose(vntResult)
      '項目1、項目2、項目3・の値を出力
      .Offset(lngRow, 1).Resize(lngCount, clngColumns).Value _
          = rngList.Offset(i, 1).Resize(, clngColumns).Value
    End With
    '出力行位置を更新
    lngRow = lngRow + lngCount
  Next i
  
  strProm = "処理が完了しました"
  
Wayout:
  
  Set rngResult = Nothing
  Set rngList = Nothing
  
'  Application.ScreenUpdating = True
  
  Beep
  MsgBox strProm
  
End Sub

【26803】Re:セルの値の移動
お礼  懐園剣  - 05/7/18(月) 20:48 -

引用なし
パスワード
   ありがとうございます。
やってみます。
お世話になりました。

【26804】Re:セルの値の移動
お礼  懐園剣  - 05/7/18(月) 20:50 -

引用なし
パスワード
   Hirofumi さん
ありがとうございます。
いろいろな方の意見が聞けてためになります。
お世話になりました。

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