Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

54744 / 76738

←次へ　｜　前へ→


	【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

0 hits

▼

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