No.1ベストアンサー
- 回答日時:
Option Explicit
Option Base 1
Sub データ正規化()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim 国 As String
Dim 品番 As String
Dim カラー As String
Dim 転送元 As Worksheet
Dim 転送先 As Worksheet
Set 転送元 = Worksheets("Sheet1")
Set 転送先 = Worksheets("Sheet2")
i = 2
j = 0
While 転送元.Cells(i, 1) <> ""
国 = 転送元.Cells(i, 1)
品番 = 転送元.Cells(i, 2)
カラー = 転送元.Cells(i, 3)
k = 1
While Cells(i, k * 2 + 2) <> ""
j = j + 1
転送先.Cells(j, 1) = 国
転送先.Cells(j, 2) = 品番
転送先.Cells(j, 3) = カラー
転送先.Cells(j, 4) = 転送元.Cells(i, k * 2 + 2)
転送先.Cells(j, 5) = 転送元.Cells(i, k * 2 + 3)
k = k + 1
Wend
i = i + 1
Wend
End Sub
データはSheet1の2行目からA列が空白になるまで
D列以降はサイズと数量の2列1組で複数組
出力はSheet12の1行目から
という仕様で書いてみました
現在酔っ払っているので解説が必要なら後日
No.2
- 回答日時:
こんにちは。
標準モジュールに貼り付けてください。
'-------------------------------------------
Sub MacroTest1()
Dim rng As Range
Dim i As Long
Dim j As Long
Dim k As Long
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
Set rng = sh1.Range("A1").CurrentRegion
Application.ScreenUpdating = False
With rng
.Resize(1, 5).Copy sh2.Cells(1, 1)
sh2.Cells(1, 5).Value = "数量"
k = 2 'タイトル行の次の行から
For i = 2 To .Rows.Count
For j = 4 To .Columns.Count Step 2
If .Cells(i, j + 1).Value <> "" Then
.Cells(i, 1).Resize(, 3).Copy sh2.Cells(k, 1)
.Cells(i, j).Resize(, 2).Copy sh2.Cells(k, 4)
k = k + 1
End If
Next j
Next i
End With
Application.ScreenUpdating = True
Set rng = Nothing
Set sh1 = Nothing
Set sh2 = Nothing
End Sub
'-------------------------------------------
なお、#1さんのコードは間違いではないのですが、お酒のせいでしょうか、以下のように直したほうがよいです。
While Cells(i, k * 2 + 2) <> ""
↓
While 転送元.Cells(i, k * 2 + 2) <> ""
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) マクロ 2行ごとの並び替えについて 4 2022/12/14 12:27
- Visual Basic(VBA) VBA横に並んでいるデータを縦に並ぶデータにしたいです。 4 2023/08/09 08:53
- Excel(エクセル) エクセルでのマクロを使ったデータの並べ替え 3 2022/12/03 18:54
- Visual Basic(VBA) Excelで横書き50行の漢字テストデータを縦書きのテスト問題にしたい。 6 2022/04/27 15:03
- Visual Basic(VBA) 【マクロ】表への繰り返し転記について 1 2022/11/19 16:30
- Visual Basic(VBA) vbaエクセルマクロについて あるデータを作成し、デスクトップに.xlsx形式で保存するマクロを作成 2 2023/03/02 18:54
- その他(Microsoft Office) パワークエリの複数ファイルのデータ統合について 3 2022/07/14 17:06
- Excel(エクセル) Excel 行 について 写真のように日付が並んでおり、何年何月何日以前は行削除。といったマクロ等組 2 2023/02/20 12:55
- Visual Basic(VBA) VBA横データを縦にしたいです 2 2023/08/08 19:38
- C言語・C++・C# C言語プログラム変更 2 2022/12/21 15:03
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
外付けHDDの80GBのデータを内蔵...
-
録音アプリのPCM録音で4時間録...
-
AccessからExcelのシートを削除
-
サーバーに転送したファイルが0...
-
転送と回送の違い
-
メール転送の禁止
-
FTP転送中断について
-
CIFS転送とFTP転送
-
ホームページビルダーのファイ...
-
Music Center for PCの楽曲をiT...
-
FTPとrcpではどちらが速いか?
-
messengerに投稿したwordファイ...
-
Beckyで手を加えずに転送の送信...
-
TCP環境下でのファイル破損は起...
-
PDFファイルをFFFTPでアップロ...
-
SDカードに書き込み中、エラー...
-
thunderbirdの転送件名を[Fwd:]...
-
FFFTPを使っているのですが画像...
-
転送しようとするとソフトが(...
-
FTP(Filezilla)で「上書きしま...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
録音アプリのPCM録音で4時間録...
-
サーバーに転送したファイルが0...
-
Music Center for PCの楽曲をiT...
-
外付けHDDの80GBのデータを内蔵...
-
大きい動画ファイルをアップロ...
-
ファイルをコピーしてる時にス...
-
転送と回送の違い
-
AccessからExcelのシートを削除
-
messengerに投稿したwordファイ...
-
FTP転送中断について
-
ホームページビルダーのファイ...
-
アンドロイドスマホに4GB以上の...
-
FTPでのGET
-
PDFファイルをFFFTPでアップロ...
-
Beckyで手を加えずに転送の送信...
-
リモートデスクトップソフトの...
-
Skypeでのファイル転送速度が遅...
-
FFFTPを使っているのですが画像...
-
メール転送の禁止
-
処理速度について
おすすめ情報