12345678910・・・・ ← 日付
田中 1 1 1
中村 1 1
鈴木 11111
・
・
・
上のようになっている表を下記のように変換したいのですが、マクロがうまく書けません。
A B C D E F G H I J K L M
1 2 3 4 5 6 7 ← 日付
田中 中村 田中 鈴木 中村 田中
鈴木 鈴木 鈴木 鈴木
Sub test01()
d = Worksheets("Sheet1").Range("A65536").End(xlUp).Row
r = Worksheets("Sheet1").Range("IV2").End(xlToLeft).Column
k = 4 '新規作成用の行ポインター
For j = 2 To r
For i = 3 To d
If Worksheets("Sheet1").Cells(i, j) = 1 Then
Worksheets("新規作成用").Cells(k, 2 * (j - 6)) = Worksheets("Sheet1").Cells(i, 2)
k = k + 1
End If
Next i
Next j
End Sub
ここまで書いていきづまってしまいました。どなたかご指南ください。
No.3ベストアンサー
- 回答日時:
こんにちは。
コード自体は慣れの問題ですから、慣れれば問題ないけれども、基本的なことは守ったほうがよいです。
変数は宣言したほうがよいですね。
Option Explicit で、変数の宣言を強制させたほうが、覚えます。
また、Cells のプロパティは、.Value を入れてください。それによって大差はないのですが、Cells, Rangeオブジェクトのプロパティには、.Value, Value2, .Text プロパティがありますので、それぞれ、使い分けなくてはならないことがありますので、習慣化しておくほうがよいです。
rとd は、読み間違えそうですので、ちょっと換えました。なお、なるべく2バイト文字やローマ字はやめて英語を使うようにするというのが、本来のVBAの書法です。その理由は、あまり意味はないと思うのですが、そういわれているということです。
'-------------------------------------------
mRow = Sh1.Range("A65536").End(xlUp).Row
mCol = Sh1.Range("IV2").End(xlToLeft).Column
k = 4 '新規作成用の開始行
For j = 2 To mCol '列
For i = 3 To mRow '行
If Worksheets("Sheet1").Cells(i, j).Value = 1 Then
Worksheets("新規作成用").Cells(k, 2 * (j - 2) + 2).Value _
= Worksheets("Sheet1").Cells(i, 1).Value
'新規作成用の最初、B4から...Cells(k, 2 * (j - 2) + 2)
'氏名のリスト..A列..Cells(i,1)
k = k + 1
End If
Next i
k = 4
Next j
'-------------------------------------------
5人の方に回答をいただき、皆様ありがとうございました。代表で、Wendy02様のお礼欄に書かせて頂きます。
昔、プログラムをいじったことがある程度なので、基本的な事項からまったく分かりません。基本的なことから教えて頂きありがとうございました。
No.5
- 回答日時:
すでに回答が出ていますが、Excel的な作業の流れとしては、
(1)各行の1を左端の名前で置き換える
(2)表を選択し、ジャンプ画面で空欄を選択し、編集ー削除で「上方向にシフト」で上へ詰める
をマクロにする方法もあります。
Sub Macro1()
Dim rowno As Integer, maxrow As Integer
'データ部を新規作成用シートへコピー
With Sheets("Sheet1")
.Range(.Range("B1"), .Range("B1").SpecialCells(xlLastCell)).Copy
End With
'以下、新規作成用シートでの作業
Sheets("新規作成用").Activate
'データ部を値貼り付け
Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
maxrowno = Selection.Rows.Count
'「1」を左端の文字列で置換
For rowno = 2 To maxrowno
Range(rowno & ":" & rowno).Replace What:="1", _
Replacement:=Sheets("Sheet1").Cells(rowno, 1).Value, LookAt:=xlWhole
Next
'表中の空欄を選択
Range("A2").CurrentRegion.SpecialCells(xlCellTypeBlanks).Select
'空欄を削除して上方向に詰める
Selection.Delete Shift:=xlUp
End Sub
私のレベルが低すぎて、どの回答が一番参考になるかすら、なかなか判断できませんが、皆様からのアドバイスはすべて有効に活用させていただきます。ありがとうございました。
No.4
- 回答日時:
VBAを続けていくなら、後々のことを考え、行単位(レコード単位)で処理をする方法が良いと思います
理由は割愛しますが続けていけば分ると思います
>For j = 2 To r
>For i = 3 To d
For i = 3 To d
For j = 2 To r
表で例を挙げるのはよいのですが、行列番号があるほうがより分りやすい
12345678910・・・・ ← 日付
田中 1 1 1
中村 1 1
鈴木 11111
・
・
・
ではなく
A BCDEFGHIJK・・・・・
1 12345678910・・・・ ← 日付
2 田中 1 1 1
3 中村 1 1
4 鈴木 11111
・
・
・
表とマクロを提示するなら、整合を取りましょう
>For j = 2 To r
>For i = 3 To d
を見ると名前はA列3行目から、データはB列3行目からと思うが
表を見ると名前はA列2行目から、データはB列2行目からに思える
また、
>Worksheets("Sheet1").Cells(i, 2)
これを見ると、名前はB列にあることになる、どれが正しい?
>Cells(k, 2 * (j - 6))
列の計算のところ、説明も無く2 * (j - 6)とされても
表を見ても、マクロを見ても矛盾している
Sheet1
A BCDEFGHIJK・・・・・
1 12345678910・・・・ ← 日付
2 田中 1 1 1
3 中村 1 1
4 鈴木 11111
を下の表のように書き出す
新規作成用
A B C D E F G H I J K L M
1 1 2 3 4 5 6 7 ← 日付
2 田中 中村 田中 鈴木 中村 田中
3 鈴木 鈴木 鈴木 鈴木
で、説明します
1 2行目をB列(日付)、C列、D列・・・とAF列まで順に見ていく
2 セルが「1」の場合、そのセル(日付)に対する列番号から、新規作成用シートの列(日付)を求める
3 その求めた列の最終行に名前を入力する
4 1~3をA列の名前がなくなるまで繰り返す
最終行の求め方を理解しているのならば、新規作成用シートに書き込むのも日付(列)の最終行に書き込めばよいと思います
提示されているマクロをなるべく使用(修正)した
サンプルを提示しておきます
Sub test01()
Dim i As Long, j As Long, k As Long
For i = 2 To Worksheets("Sheet1").Range("A65536").End(xlUp).Row
For j = 2 To 32
If Worksheets("Sheet1").Cells(i, j) = 1 Then
k = Worksheets("新規作成用").Cells(Rows.Count, 2 * (j - 1)).End(xlUp).Offset(1).Row '新規作成用の行ポインター
Worksheets("新規作成用").Cells(k, 2 * (j - 1)) = Worksheets("Sheet1").Cells(i, 1).Value
End If
Next j
Next i
End Sub
No.2
- 回答日時:
>2 * (j - 6)
j=2とかのときマイナスになるので明らかにおかしい。
>Worksheets("Sheet1").Cells(i, 2)
Cells(i, 1) では?
>Next i
>Next j
1列ずれるので
Next i
k = 4
Next j
No.1
- 回答日時:
よく見たわけではありませんが
K=4の記述場所間違っています
転記先の列の計算が間違っているように思います。
このコードは
以下の処理を一日から31日まで行う
日ごとに下に順に見ながら"1"があったら名前を転記する
大雑把に疑似コードを書くと
for 一日目から31日まで
for 2行目から最後の行まで
もし そのセルが1だったら名前を(k行目,日にち目)セルに転記する
そのあとKを1増やす
Next
Next
日にち目のセルつまり転送先の列番号の計算
転送先が1日分が2列なので2 * (j - 6))という記述にしてますが
ここはたぶん2*j-6 (6じゃないかもしれないけど定数)と記述すべきでしょう。
あとKは1日分処理するごとに初期化(K=4)すべきですから
1個目のForの次の行に移動する
行き詰った時はステップ実行をしながら変数の値が自分の意図したようになっているか確認すると問題点が絞れます。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) なぜExit Subがあるのかわかりません 4 2023/02/19 12:34
- Excel(エクセル) マクロ(データ取得と転記)について教えてください 3 2022/12/24 12:18
- Visual Basic(VBA) 3つのプロシージャをまとめたら実行時エラー発生で対応不能 6 2022/05/17 01:47
- Visual Basic(VBA) EXCELのVBAについて 2 2023/07/05 17:17
- Excel(エクセル) VBAについて 3 2022/06/19 18:19
- Visual Basic(VBA) 他のシートからコピーする下記マクロで貼付け位置をWorksheets(1).Range("A3")の 8 2023/01/30 18:48
- Visual Basic(VBA) ユーザーフォーム「frm_基本❶」を立ち上げると新規で入力する行数を右下のNoとして表示しています。 1 2023/03/16 19:02
- Visual Basic(VBA) VBAコードが作動せず、どこに問題があるのか教えて下さい。 3 2023/06/13 13:20
- Visual Basic(VBA) ExcelVBAの転記について 1 2022/03/23 20:13
- Visual Basic(VBA) VBAで最新のデータを別シートに転記する方法をお教えください。 3 2022/04/07 19:20
関連するカテゴリからQ&Aを探す
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
【Excel VBA】CSV取込時、数字...
-
Word2016でExcelデータを差込し...
-
エクセルで前年同日・前月同日...
-
エクセルでページ毎の計をつけ...
-
ピボットテーブル作成後、重複...
-
EXCELの列の幅
-
EXCEL2007で2つのシートのどっ...
-
EXCELで2つのシートから一致し...
-
Excelのセル内で規則に従った部...
-
エクセルで2列以上のものを同時...
-
エクセルで、列や行の幅などセ...
-
Excelのhperlink関数で作ったモ...
-
エクセルで電話番号にハイフン...
-
Excelで日付を入れると自動的に...
-
Excelで奇数行を削除
-
VBAで他のシートの特定の列を検...
-
複数データを検索して同じデー...
-
Excelで縦割りを途中から増やす...
-
【Excel VBA】データの最終行に...
-
エクセルVBAで同じ種類を集計し...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Word2016でExcelデータを差込し...
-
【Excel VBA】CSV取込時、数字...
-
EXCELで2つのシートから一致し...
-
EXCELの列の幅
-
Excel 表の必要箇所だけを抜き...
-
エクセルでページ毎の計をつけ...
-
pdfの表をexcelにはりつけて計...
-
EXCEL2007で2つのシートのどっ...
-
エクセルで前年同日・前月同日...
-
エクセルで電話番号にハイフン...
-
excelの列がいっぱいになり列を...
-
ExcelのIF関数について
-
エクセルVBAで複数列データを1...
-
エクセルシートの選択範囲をコ...
-
エクセルの複数ワークシートの...
-
EXCELで不良率を出そうと思って...
-
エクセルの余白を0にしても列...
-
Excelで縦割りを途中から増やす...
-
マクロ VBA 他のブックのデータ...
-
エクセルで2列以上のものを同時...
おすすめ情報