□ 戻る □一般操作のサロン □ 使用方法 □ 新着記事 □ 新規に質問する！ □ トピック一覧 □ 検索 □ 過去ログ
[ 最新記事及び返信フォームをトピックトップへ ]
| 配列への値の格納 | |
|---|---|
[195013] 配列への値の格納- ■親トピック/記事引用/メール受信=OFF■ □投稿者/ Univ. -(2022/06/23(18:00)) □U R L/ よろしくお願い致します。
データとして，以下のようなものがあります。
1行目がタイトル行 B1にはQ1, C1にはQ2， D1にはQ3
A列には人の名前10人
B2:D11には空白もあればなにかテキストが入力されているものもある。
B2:D11のセルの中で何か入力されていた場合は，次のような操作をしたい。
例えば...C5になにか入力されていたら，その中身とその列名（C1にある"Q2"），そして，その行にある"人名"をSheet2のA2, B2, C2に順に人名，列名（"Q2"），C3にはC5の内容を書き出し，もしC5以外でB2:D11に何か記入されているセルがあれば， A3, B3, C3に同様に書き出すというコードにしたいです。
あるサイトから見よう見まねで書いたもののここから先へはまったくすすめません。プロの方に加筆修正をお願いしたいのです。よろしくお願い致します。
Sub sample()
Dim arr() As Variant
Dim rng As Range
Dim i As Long
With Worksheets("Sheet1")
ReDim arr(0)
For Each rng In Worksheets("Sheet1").Range("B2:D11")
If rng.Value <> "" Then
arr(UBound(arr)) = rng.Value
ReDim Preserve arr(UBound(arr) + 1)
End If
Next rng
End With
arr = Application.Transpose(arr)
Worksheets("Sheet2").Range("A1").Resize(UBound(arr)).Value = arr
End Sub
この記事にはVBAのコードが含まれています。 緑の太文字→注釈 茶色の太文字→条件分岐 赤の太文字→ループ 青の太文字→その他 | |
[195014] Re[1]: 配列への値の格納- ■記事引用/メール受信=OFF■ □投稿者/ マナ -(2022/06/23(18:46)) □U R L/ こんな感じでどうですか
Sub sample2()
Dim arr() As Variant
Dim rng As Range
Dim n As Long, r As Long, c As Long
Set rng = Worksheets("Sheet1").Range("B2:D11")
ReDim arr(1 To 3, 1 To WorksheetFunction.CountA(rng))
For r = 1 To rng.Columns.Count
For c = 1 To rng.Rows.Count
If rng(r, c).Value <> "" Then
n = n + 1
arr(1, n) = rng(r, 0).Value
arr(2, n) = rng(0, c).Value
arr(3, n) = rng(r, c).Value
End If
Next
Next
Worksheets("Sheet2").Range("A2").Resize(n, 3).Value _
= Application.Transpose(arr)
End Subこの記事にはVBAのコードが含まれています。 緑の太文字→注釈 茶色の太文字→条件分岐 赤の太文字→ループ 青の太文字→その他 | |
[195015] Re[2]: 配列への値の格納- ■記事引用/メール受信=OFF■ □投稿者/ マナ -(2022/06/23(19:08)) □U R L/ ＞ For r = 1 To rng.Columns.Count ＞ For c = 1 To rng.Rows.Count ColumnsとRowsは、逆でした。 この記事にはVBAのコードが含まれています。 緑の太文字→注釈 茶色の太文字→条件分岐 赤の太文字→ループ 青の太文字→その他 | |
[195016] Re[3]: 配列への値の格納- ■記事引用/メール受信=OFF■ □投稿者/ マナ -(2022/06/24(07:52)) □U R L/ ↑失敗。縦横が逆の配列をわざわざ用意して 最後にTransposeするという無駄なことをしていました。 | |
[195017] Re[4]: 配列への値の格納- ■  / 記事引用/メール受信=OFF■
□投稿者/ Univ. -(2022/06/24(09:25)) □U R L/ マナさん お返事が大変遅くなりまして申し訳ございません。不快にさせてしまったのなら申し訳ございません。 先ほど出勤しまして掲示版を確認し，マナさんからのコード（修正含む）で私が希望することは完璧にできました。マナさんには「無駄な」ところがあったようにお見受けしますが，私には一行一行が大変勉強になりました。私は回答頂きましたものでも十分満足しておりますが，もしマナさんの方でさらに洗練されたものをご教示頂けるのであれば幸いです。ただ私はこれで十分満足しておりますので，いったん，解決マークをチェック致しますね。 ありがとうございます。 | |
[195018] Re[5]: 配列への値の格納- ■記事引用/メール受信=OFF■ □投稿者/ マナ -(2022/06/24(18:59)) □U R L/ こんな感じです
Sub sample2()
Dim arr() As Variant
Dim rng As Range
Dim n As Long, r As Long, c As Long
Set rng = Worksheets("Sheet1").Range("B2:D11")
ReDim arr(1 To WorksheetFunction.CountA(rng), 1 To 3)
For r = 1 To rng.Rows.Count
For c = 1 To rng.Columns.Count
If rng(r, c).Value <> "" Then
n = n + 1
arr(n, 1) = rng(r, 0).Value
arr(n, 2) = rng(0, c).Value
arr(n, 3) = rng(r, c).Value
End If
Next
Next
Worksheets("Sheet2").Range("A2").Resize(n, 3).Value = arr
End Sub
この記事にはVBAのコードが含まれています。 緑の太文字→注釈 茶色の太文字→条件分岐 赤の太文字→ループ 青の太文字→その他 | |