『縦1列のデータを横1行に変更して値の代入』（訓練中）
A列
2 aaa
3 30
4 40
5 2000
6 2
7 aaa
8 30
9 40
10 1000
11 3
12 bbb
13 100
14 300
15 2
16 ccc
17 500
18 2000
19 4
・
・
・
というデータを
D2セル以降に以下のようにしたいです。
D列 E列 F列 G列 H列 I列
2 aaa 30 40 2000 2
3 aaa 30 40 1000 3
4 bbb t9 100 300 2
5 ccc t2.5 500 2000 4
・
・
・
そこで、
"aaa"の場合、"aaa","","30","40","2000","2"のような配列を作ってD列〜I列に値を代入
"bbb"の場合、"bbb","t9","100","","300","2"のような配列を作ってD列〜I列に値を代入
"ccc"の場合、"ccc","t12","500","","2000","4"のような配列を作ってD列〜I列に値を代入
をすることを考えました。
Classを使って、各メンバ変数に入れたものを一次元配列にしたいと思い、
以下のようなコードを書きましたが
Exchange = Array(cData)
のコードのところで、思うような一次元配列にならずに困惑しています。
ブレイクポイントを置いてウォッチ式の「Exchange」をみると
"40"
"2000"
"aaa"
"2"
""
"30"
"aaa"
"40"
"2000"
""
"30"
"2"
となっています。
そのまま続けると
「アプリケーション定義又はオブジェクトの定義エラーです」
というエラーが返ってきます。
ちなみにクラスモジュールを使っている理由は、
クラスを使う勉強中(慣れる)ためなので、
特別クラスモジュールを使う必要があるというわけではありません。
clsDataのメンバを変数にして、
rng_w.Resize(, 6).Value = Exchange(rng_r, ret)
のように一括で値の代入できる方法をご存じの方
教えていただけますでしょうか。
複数行×1列の二次元配列でも構いません。
どうぞよろしくお願いいたします。
【標準モジュール】
Option Explicit
Sub Main()
Dim rng_r As Range
Dim rng_w As Range
Dim ret As Long
Set rng_r = Worksheets("Sheet1").Range("A2")
Set rng_w = Worksheets("Sheet1").Range("D2")
Do Until rng_r.Value = ""
rng_w.Resize(, 6).Value = Exchange(rng_r, ret)
Set rng_r = rng_r.Offset(ret)
Set rng_w = rng_w.Offset(1)
Loop
End Sub
Function Exchange(rng As Range, lngCount As Long) As Variant
Dim cData As New clsData
With cData
Select Case rng.Value
Case "aaa"
.Material = rng.Value
.p_t = ""
.p_W = rng.Offset(1, 0).Value
.p_D = rng.Offset(2, 0).Value
.p_H = rng.Offset(3, 0).Value
.Quant = rng.Offset(4, 0).Value
lngCount = 5
Case "bbb"
.Material = rng.Value
.p_t = "t9"
.p_W = rng.Offset(1, 0).Value
.p_D = ""
.p_H = rng.Offset(2, 0).Value
.Quant = rng.Offset(3, 0).Value
lngCount = 4
Case "ccc"
.Material = rng.Value
.p_t = "t2.5"
.p_W = rng.Offset(1, 0).Value
.p_D = ""
.p_H = rng.Offset(2, 0).Value
.Quant = rng.Offset(3, 0).Value
lngCount = 4
End Select
End With
Exchange = Array(cData)
End Function
【クラスモジュール】オブジェクト名：clsData
Option Explicit
Private m_Material As String
Private m_t As String
Private m_W As String
Private m_D As String
Private m_H As String
Private m_Quantity As String
Public Property Let Material(strMaterial As String)
m_Material = strMaterial
End Property
Public Property Get Material() As String
Material = m_Material
End Property
Public Property Let p_t(dbl_t As String)
m_t = dbl_t
End Property
Public Property Get p_t() As String
p_t = m_t
End Property
Public Property Let p_W(dbl_W As String)
m_W = dbl_W
End Property
Public Property Get p_W() As String
p_W = m_W
End Property
Public Property Let p_D(dbl_D As String)
m_D = dbl_D
End Property
Public Property Get p_D() As String
p_D = m_D
End Property
Public Property Let p_H(dbl_H As String)
m_H = dbl_H
End Property
Public Property Get p_H() As String
p_H = m_H
End Property
Public Property Let Quant(lng_Q As String)
m_Quantity = lng_Q
End Property
Public Property Get Quant() As String
Quant = m_Quantity
End Property
Private Sub Class_Initialize()
m_Material = ""
m_t = ""
m_W = ""
m_D = ""
m_H = ""
m_Quantity = ""
End Sub
＜ 使用 Excel：Microsoft365、使用 OS：Windows11 ＞
Sub main()
Dim rng_r As Range
Dim rng_w As Range
Dim ret As Long
Set rng_r = Worksheets("Sheet1").Range("A2")
Set rng_w = Worksheets("Sheet1").Range("D2")
Do Until rng_r.Value = ""
rng_w.Resize(, 6).Value = Exchange(rng_r, ret)
Set rng_r = rng_r.Offset(ret)
Set rng_w = rng_w.Offset(1)
Loop
End Sub
Function Exchange(rng As Range, lngCount As Long) As Variant
Dim cData As New clsData
With cData
Select Case rng.Value
Case "aaa"
.Material = rng.Value
.p_t = ""
.p_W = rng.Offset(1, 0).Value
.p_D = rng.Offset(2, 0).Value
.p_H = rng.Offset(3, 0).Value
.Quant = rng.Offset(4, 0).Value
lngCount = 5
Case "bbb"
.Material = rng.Value
.p_t = "t9"
.p_W = rng.Offset(1, 0).Value
.p_D = ""
.p_H = rng.Offset(2, 0).Value
.Quant = rng.Offset(3, 0).Value
lngCount = 4
Case "ccc"
.Material = rng.Value
.p_t = "t2.5"
.p_W = rng.Offset(1, 0).Value
.p_D = ""
.p_H = rng.Offset(2, 0).Value
.Quant = rng.Offset(3, 0).Value
lngCount = 4
End Select
End With
Exchange = cData.ValueArray
End Function
'【クラスモジュール】オブジェクト名：clsData Option Explicit
Public Material As String Public p_t As String Public p_W As String Public p_D As String Public p_H As String Public Quant As String
Public Property Get ValueArray()
ValueArray = Array(Material, p_t, p_W, p_D, p_H, Quant)
End Property
（´・ω・`） 2026/07/08(水) 14:01:22
D2 = aaa, F2 = 30, G2 = 40, H2 = 2000, I2 = 2
D3 = aaa, F3 = 30, G3 = 40, H3 = 1000, I3 = 3
D4 = bbb, F4 = 100, H4 = 300, I4 = 2
D5 = ccc, F5 = 500, H5 = 2000, I5 = 4
以下のVBAでは？
Sub 整形してD列以降へ出力()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long, outRow As Long
Dim v As String
Dim key As String
Dim nums(1 To 4) As Variant
Dim n As Long
Set ws = ActiveSheet
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
ws.Range("D2:I" & ws.Rows.Count).ClearContents
i = 2
outRow = 2
Do While i <= lastRow
v = Trim$(CStr(ws.Cells(i, "A").Value))
If v <> "" And Not IsNumeric(v) Then
key = v
Erase nums
n = 0
i = i + 1
Do While i <= lastRow
v = Trim$(CStr(ws.Cells(i, "A").Value))
If v <> "" And Not IsNumeric(v) Then Exit Do
If v <> "" Then
n = n + 1
If n <= 4 Then nums(n) = ws.Cells(i, "A").Value
End If
i = i + 1
Loop
ws.Cells(outRow, "D").Value = key
ws.Cells(outRow, "E").ClearContents
Select Case key
Case "aaa"
If n >= 1 Then ws.Cells(outRow, "F").Value = nums(1)
If n >= 2 Then ws.Cells(outRow, "G").Value = nums(2)
If n >= 3 Then ws.Cells(outRow, "H").Value = nums(3)
If n >= 4 Then ws.Cells(outRow, "I").Value = nums(4)
Case "bbb", "ccc"
If n >= 1 Then ws.Cells(outRow, "F").Value = nums(1)
If n >= 2 Then ws.Cells(outRow, "H").Value = nums(2)
If n >= 3 Then ws.Cells(outRow, "I").Value = nums(3)
Case Else
If n >= 1 Then ws.Cells(outRow, "F").Value = nums(1)
If n >= 2 Then ws.Cells(outRow, "G").Value = nums(2)
If n >= 3 Then ws.Cells(outRow, "H").Value = nums(3)
If n >= 4 Then ws.Cells(outRow, "I").Value = nums(4)
End Select
outRow = outRow + 1
Else
i = i + 1
End If
Loop
End Sub
（稚拙） 2026/07/08(水) 14:03:21
＞Exchange = Array(cData) ＞のコードのところで、思うような一次元配列にならずに困惑しています。
1個のcDataを配列に入れているだけで、所望の配列にはならないです。
cDataクラスの方でデータ配列を返させるPorpertyを追加して対応したらどうですか。
(例）
Public Property Get DataInArray() As Variant
DataInArray = Array(m_Material, m_t, m_W, m_D, m_H, m_Quantity)
End Property
＞Exchange = Array(cData) ↓変更 Exchange = cData.DataInArray
（半平太） 2026/07/08(水) 14:23:16
ご回答ありがとうございます。
Public Property Get DataInArray() As Variant
DataInArray = Array(m_Material, m_t, m_W, m_D, m_H, m_Quantity)
End Propert
今回はクラスのメンバ変数を配列で返す
「Property Get」
で対応いたします。
このような発想が浮かびませんでした。
また、今回のようなやり方は、他の時でも使えそうです。
本当にありがとうございました。
（訓練中） 2026/07/08(水) 15:07:37
あれ、すみません、二番煎じだったです。
（´・ω・`）さんの回答を見てなかったです。 m(__)m
（半平太） 2026/07/08(水) 16:05:45
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.