Excel VBA 質問スレッド No.142 (未解決)

至急 助けてください

投稿者 : mikitaro     投稿日時 : 2020/11/30(Mon) 20:40:30     OS : 未指定     EXCEL : 未指定
急いでます。エクセルのVBAで下記のようなことは可能でしょうか
このようなリストがある時に
リスト①
個人ID 氏名 項目数 項目1 項目2 項目3 項目4
0001 見本太郎 4 0001 0002 0003 0004
0002 見本花子 2 0004 0005

下記の形のリストに変換したいです
リスト②
個人ID 氏名 項目1 項目2 項目3
0001 見本 太郎 0001 0002 0003
0001 見本 太郎 0004
0002 見本 花子 0004 0005

実際はリスト①の項目数はマックスで16個あり
リスト②で持てる項目数は9までです
また対象となるIDと氏名はもっとたくさんあります。

説明べたで大変恐縮ですがご教示ください。

補足
リスト②もエクセルにしたいです
1シート目にリスト①があったら、マクロを回すことで1シート目にリスト②ができると嬉しいです

[返信 1] Re : 至急 助けてください
投稿者 : mikitaro     投稿日時 : 2020/11/30(Mon) 21:02:19
1シート目にリスト①があったら、マクロを回すことで1シート目にリスト②ができると嬉しいです

正しくは
1シート目にリスト①があったら、マクロを回すことで2シート目にリスト②ができると嬉しいです

[返信 2] Re : 至急 助けてください
投稿者 : ヘンリー     投稿日時 : 2020/12/02(Wed) 05:26:19
>至急 助けてください
>急いでます。

「無料の掲示板は、「至急」或いは「急いでいる」場合には適していません。
クラウドワークスなどで、有料で請け負ってくれる人に頼むべきです。」

という事を、私は、別の掲示板で教えて頂きました。

又、コードの代筆についても同様な事を教えて頂きましたので、
今回の私からの回答はヒントまでとさせて頂きます。

>エクセルのVBAで下記のようなことは可能でしょうか

VBAなら、通常のユーザーがして欲しい事は、ほとんど可能です。

多少不明確の部分がありますが…
【不明点】
1 まず、氏名の姓と名の間に半角スペースを入れることは困難です。
 (何か別のキーや区切り文字があれば別ですが…)
2 1シート目、2シート目という区別で本当に良いでしょうか。
 確か、Excelは作られた順番にシートのインデックスが振られます。
 途中でシート削除等の操作をすると、予期せぬ事が発生します。
 通常は、シート名を指定した方が良いかと思います。
3 1シート目にリスト①があったら、とありますが、1シート目、2シート目には
  必ず項目名があるのでしょうか。


【前提条件】
上記の
不明点1は無視します。
不明点2については、あいまいなので1シート目、2シート目と表記します。
不明点3は1シート目、2シート目の1行目には、必ず項目名があると仮定します。

以下の様に記述していきます。

シートの指定をインデックスで指定したい場合は
Worksheets(n)→()内の数値でn番目と指定します。

・1シート目のデータの最終行を求めます。
→xlUpについて調べてみて下さい。

・データの最終行が、数値の1の場合(1シート目にリスト①がなかったら)、処理を終了します。
→If文について、調べてみて下さい。

・読み込み行が、2行目から、データの最終行まで繰り返し処理をします。
→For~Next文について調べてみて下さい。

・読み込みの項目4にデータが入っていたら、欠き込み行に1を足した行に、項目4以降のデータを代入します。
→If文、インクリメントについて、調べてみて下さい。

・読み込み行に1を足した行を読みます。
→インクリメントについて調べてみた下さい。

以上、お急ぎとの事なので、当然、当方でのテストはできませんので、
考え方の説明のみとさせて頂きました。

ご了承のほどお願いいたします。

[返信 3] Re : 至急 助けてください
投稿者 : sander     投稿日時 : 2020/12/12(Sat) 12:10:40
こんなかんじか?
Sub tes01()
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim aRange As Range, gRange As Range, idRange As Range
Dim bRange As Range, sRange As Range
Dim GyoMax As Double, n As Double, m As Double
Dim bGyou As Double, aRetu As Integer
Dim Orikaesi As Integer

'変換後の1行の項目数
Orikaesi = 3
'入力シート
Set Sh1 = ThisWorkbook.Sheets("a")
'出力シート
Set Sh2 = ThisWorkbook.Sheets("b")



Set aRange = Sh1.Range("A1").CurrentRegion
Set aRange = Intersect(aRange, aRange.Offset(1, 0))

Set bRange = Sh2.Range("A1").CurrentRegion
bGyou = bRange.Rows.Count + 1

GyoMax = aRange.Rows.Count
For n = 1 To GyoMax
'1行切り出し
Set gRange = Intersect(aRange, aRange.Rows(n))
Set idRange = Intersect(gRange, gRange.Resize(1, 2))
aRetu = gRange.Columns.Count - 3
For m = 1 To aRetu Step Orikaesi
Set sRange = Intersect(gRange, gRange.Offset(0, m + 2).Resize(1, Orikaesi))

If sRange.Columns(1).Value = "" Then Exit For
'ID氏名
idRange.Copy Sh2.Cells(bGyou, 1)
'項目
sRange.Copy Sh2.Cells(bGyou, 3)
bGyou = bGyou + 1
Next
Next

End Sub

[返信 4] Re : 至急 助けてください
投稿者 : 理沙     投稿日時 : 2021/01/02(Sat) 15:29:27
  A B C D •••
1 82
2
:
:
21 赤 52 23 x
22 白 25 3
23 青. 5
24 95
25
:
50 3

この様なExcel の表があるときに
A列に文字が入っている場合に限り
b列に数字が入っている個数を
カウントしたいのです。
 
上の例では、21〜23行なので
3という値をセルD50に
書き込みたいのです。

初心者でループが上手くかみ合いません。
どなたかご教授ください。

[返信 5] Re : 至急 助けてください
投稿者 : EUNO     投稿日時 : 2021/01/04(Mon) 15:19:58
新規質問として投稿された方が分かりやすいと思います。
とりあえず2行目から50行目を対象にしています。
可変にしたい場合は終端セルをEndプロパティなどで取得するなど工夫してください。
文字列判定・数値判定は厳密には正しくない場合もあるかもしれません。

Sub test3()

Dim i As Long 'ループ変数
Dim n As Long '求める数値
n = 0

For i = 2 To 50
If VarType(Cells(i, 1).Value) = vbString And IsNumeric(Cells(i, 2).Value) = True And Cells(i, 2).Value <> "" Then
n = n + 1
End If
Next i

Range("D50") = n

End Sub

当掲示板について
返信入力フォーム
お 名 前  :
内  容   :
ステータス  : この質問を解決済みにする

認証コード  :
        キャプチャ画像


( 処理日時 : 2021-01-27 12:39:29 )

Page
Top