マクロ初心者です。手作業に限界を感じマクロを勉強しましたが力不足です。
質問ではなく申し訳ございませんがよろしくお願いします。
コピーして貼り付けるだけのことなのですが、
以下が元のデータです。
認識コード名称日付
00000229A2012/2/21
00000229A2010/10/5
00000470B2012/3/30
00000470B2011/3/31
00000496C2011/7/5
00000496C2010/8/17
00000496C空白
変更後の形です。
認識コード名称日付
00000229A2012/2/212010/10/5
00000470B2012/3/302011/3/31
00000496C2011/7/52010/8/17 空白
元データにある認識コードが同じ項目の日付を横に並べていきたいですのですが
繰り返しを含め空白欄のコピーもうまくできません。
厚かましいこと極まりないですが、ご指導していただければと思います。
No.3ベストアンサー
- 回答日時:
No.2です!
日付が表示されない!というコトですが・・・
おそらくSheet1のA列が文字列になっているのでは?
前回のコードはSheet1のA列は数値で表示形式が8桁となっている前提のコードでしたので
Sheet2のA列も数値を8桁表示としていました。
そうなると当然Sheet2のA・B列と一致するものはSheet1にはないので
日付部分は全く表示されないと思います。
もう一度コードを載せてみます。(ほとんど前回同様です)
今回はSheet1のA列が文字列だとしてのコードです。
Sub test() 'この行から
Dim i, k As Long
Dim myArray As Variant
Dim ws As Worksheet
Set ws = Worksheets("Sheet2") '←「Sheet2」は実際のSheet名に!
Application.ScreenUpdating = False
i = ws.Cells(Rows.Count, 1).End(xlUp).Row
If i > 1 Then
ws.Rows(2 & ":" & i).ClearContents
End If
ws.Columns(1).NumberFormatLocal = "@" 'この行を追加
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
ws.Cells(Rows.Count, 1).End(xlUp).Offset(1) = _
Cells(i, 1) & "_" & Cells(i, 2)
Next i
For i = ws.Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If WorksheetFunction.CountIf(ws.Columns(1), ws.Cells(i, 1)) > 1 Then
ws.Cells(i, 1).Delete (xlUp)
End If
Next i
For i = 2 To ws.Cells(Rows.Count, 1).End(xlUp).Row
myArray = Split(ws.Cells(i, 1), "_")
For k = 0 To 1
ws.Cells(i, k + 1) = myArray(k)
Next k
Next i
'前回のここの行を削除
For k = 2 To ws.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(i, 1) = ws.Cells(k, 1) And Cells(i, 2) = ws.Cells(k, 2) Then
If Cells(i, 3) <> "" Then
With ws.Cells(k, Columns.Count).End(xlToLeft).Offset(, 1)
.Value = Cells(i, 3)
.NumberFormatLocal = "yyyy/m/d"
End With
Else
ws.Cells(k, Columns.Count).End(xlToLeft).Offset(, 1) = " "
End If
End If
Next i
Next k
Application.ScreenUpdating = True
End Sub 'この行まで
※ 今回は上手く動けば良いのですが・・・m(_ _)m
tom04さん ご指摘の通りでした。
完璧すぎてなんとお礼を言ってらよいか困っております。
仕事で必ず出てくるこの認識コードにはいつも振り回されています。
関数(Vlook等)でも手間をかけないとエラーばかり出ます。もう少し
変数の勉強するよう心がけます。
ありがとうございました。
No.2
- 回答日時:
こんばんは!
一例です。
Sheet1のデータをSheet2に表示するようにしてみました。
画面左下の元データがあるSheet見出し上で右クリック → コードの表示 → VBE画面に
↓のコードをコピー&ペーストしてマクロを実行してみてください。
(Alt+F8キー → マクロ → マクロ実行です)
Sub test() 'この行から
Dim i, k As Long
Dim myArray As Variant
Dim ws As Worksheet
Set ws = Worksheets("Sheet2") '←「Sheet2」は実際のSheet名に!
Application.ScreenUpdating = False
i = ws.Cells(Rows.Count, 1).End(xlUp).Row
If i > 1 Then
ws.Rows(2 & ":" & i).ClearContents
End If
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
ws.Cells(Rows.Count, 1).End(xlUp).Offset(1) = _
Cells(i, 1) & "_" & Cells(i, 2)
Next i
For i = ws.Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If WorksheetFunction.CountIf(ws.Columns(1), ws.Cells(i, 1)) > 1 Then
ws.Cells(i, 1).Delete (xlUp)
End If
Next i
For i = 2 To ws.Cells(Rows.Count, 1).End(xlUp).Row
myArray = Split(ws.Cells(i, 1), "_")
For k = 0 To 1
ws.Cells(i, k + 1) = myArray(k)
Next k
Next i
ws.Columns(1).NumberFormatLocal = "00000000"
For k = 2 To ws.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(i, 1) = ws.Cells(k, 1) And Cells(i, 2) = ws.Cells(k, 2) Then
If Cells(i, 3) <> "" Then
With ws.Cells(k, Columns.Count).End(xlToLeft).Offset(, 1)
.Value = Cells(i, 3)
.NumberFormatLocal = "yyyy/m/d"
End With
Else
ws.Cells(k, Columns.Count).End(xlToLeft).Offset(, 1) = " "
End If
End If
Next i
Next k
Application.ScreenUpdating = True
End Sub 'この行まで
※ For~Next を多用していますので、データ量が多い場合は少し時間がかかると思います。
参考になりますかね?m(_ _)m
この回答への補足
認識コード/名称/日付
00000001 /A/2012/1/6
00000001/A/2012/6/7
00000001/A/2012/6/7
00000004/B/2012/3/23
00000004/B/2012/6/16
00000005/C/2012/4/19
00000005/C/2012/5/28
捕捉欄に書き込んだ内容が元データの形です。これでもうまく表示できません。
(1)8ケタの数字が認識コード
(2)大文字アルファベットが名称
(3)日付
と3列にデータが入っています
作成していただいたマクロを実行したところ
日付がなぜかありませんでした。わかる範囲でマクロの内容を確認して
変更してみます。こんなに親切に指導していただけてとても
感謝しております。
tom04さん ありがとうございました。
No.1
- 回答日時:
認識コード名称がA列、日付がB列で、1行目から入っているとする。
1.認識コード名称を昇順、日付を降順でソートする(と言うか、既にソートされていると思う)
2.C1セルに「1」と入力する。
3.C2セルに「=IF(A2=A1,0,1)」と入力する。
4.C2セルを下方向に表の終りまでコピーする。
表は
A B C
1 00000229A 2012/2/21 1
2 00000229A 2010/10/5 0
3 00000470B 2012/3/30 1
4 00000470B 2011/3/31 0
5 00000496C 2011/7/5 1
6 00000496C 2010/8/17 0
7 00000496C 空白 0
となる筈。
5.D1セルに「=IF($C1=0,"",IF(ISBLANK(OFFSET($B1,COLUMN()-4,0)),"",IF($A1=OFFSET($A1,COLUMN()-4,0),OFFSET($B1,COLUMN()-4,0),"")))」と入力して書式を日付にする。
6.D1セルを右方向に必要なだけE1~にコピーする。日付を横に10個並べたいなら、E1~M1にコピー。
7.E1~M1を範囲指定して、下方向に表の終りまでコピーする。
表が
A B C D E
1 00000229A 2012/2/21 1 2012/2/21 2010/10/5
2 00000229A 2010/10/5 0
3 00000470B 2012/3/30 1 2012/3/30 2011/3/31
4 00000470B 2011/3/31 0
5 00000496C 2011/7/5 1 2011/7/5 2010/8/17
6 00000496C 2010/8/17 0
7 00000496C 空白 0
となる筈。
8.D~M列を範囲選択してCtrl+Cで「コピー」する。
9.そのまま「編集」「形式を指定して貼り付け」「値のみ」で、貼り付けする。見た目には変化しない。
10.オートフィルタで「C列の値が0の物だけ」を表示する。
表が
A B C D E
1 0000022▽ 2012/2/▽ ▽ 2012/2/▽ 2010/10▽
2 00000229A 2010/10/5 0
4 00000470B 2011/3/31 0
6 00000496C 2010/8/17 0
7 00000496C 空白 0
となる筈。1行目の「▽」は、オートフィルタのマーク。
11.表の2行目から最後までを範囲選択して「行削除」する。1行目は消さない事。
12.オートフィルタを解除する。
表が
A B C D E
1 00000229A 2012/2/21 1 2012/2/21 2010/10/5
2 00000470B 2012/3/30 #REF! 2012/3/30 2011/3/31
3 00000496C 2011/7/5 #REF! 2011/7/5 2010/8/17
となる筈。
13.B列、C列を「列削除」する。
表が
A B C
1 00000229A 2012/2/21 2010/10/5
2 00000470B 2012/3/30 2011/3/31
3 00000496C 2011/7/5 2010/8/17
となって完成。
この回答への補足
chie65535さんへ
ありがとうございました。
とても参考になりました。
教えていただいた方法を元にもう少し頑張ってマクロにできればと思います。
元データの記載方法が悪く一部訂正させて頂きます。
A列 B列 C列
認識コード 名称 日付
00000496 C 2011/7/5
不慣れなもので御礼を捕捉に書き込んでいました。
大変失礼しました。
改めてですいません。
ありがとうございました。
参考にさせていただきます。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) Excelのマクロコードについて教えてください。 1 2022/03/27 13:25
- Excel(エクセル) エクセルのマクロについて教えてください。 3 2023/02/07 14:47
- Excel(エクセル) Excelで質問です! 現在マクロを勉強中の初心者です。 以下のような表から、会社名が空白のもの以外 2 2022/06/14 12:16
- Visual Basic(VBA) VBAコードを張り付け後のエクセルの進め方 2 2023/02/07 18:24
- Excel(エクセル) VBA 特定の列に入っているテキストをコピペ 2 2023/06/14 11:24
- Excel(エクセル) 1つのファイルを3つのフォルダにファイル名を【明日の日付】にして、コピーをしたい 2 2022/12/21 17:43
- Visual Basic(VBA) 4月~3月まで12カ月横に並んだ表へ指定範囲を貼り付けたい。 Sheet2の指定範囲、Range(" 2 2022/11/30 16:37
- Visual Basic(VBA) 集計シートA列のコードと一致する右に並んだシート名(コード)の3行目から10行目をコピーして貼り付け 4 2022/08/18 15:24
- Visual Basic(VBA) 指定月分の顧客データファイルを統合して並べ替え、所定の場所に貼り付ける 3 2022/09/10 07:55
- Visual Basic(VBA) VBAを使いシート間で貼り付け 3 2023/03/14 20:53
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excel2017 フィルタ昇順並びがA...
-
Excelで並び替え後にア行...
-
オートフィルタ後のデータから...
-
急ぎ!色のついたセルを非表示...
-
エクセルで行の高さ及び列幅の...
-
基準日以前のデータを範囲を指...
-
プルダウンに【なし、平均、デ...
-
EXCELで日付を比べ3か月以内の...
-
平均変化率の信頼区間
-
VBA 複数行の検索及び抽出
-
【Excel VBA】指定した行の最大...
-
文字列を比較し、相違するフォ...
-
特定の行を選択して別のシート...
-
エクセル VBA 行間隔を飛ばした...
-
エクセル関数について
-
エクセル データの入力規制「リ...
-
エクセル関数について
-
Excelで任意の文字列を半角スペ...
-
EXCELマクロを使い、空白行では...
-
エクセル 複数行ある同一商品...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Excel2017 フィルタ昇順並びがA...
-
Excelで並び替え後にア行...
-
エクセルで行の高さ及び列幅の...
-
平均変化率の信頼区間
-
急ぎ!色のついたセルを非表示...
-
オートフィルタ後のデータから...
-
【Excel VBA】指定した行の最大...
-
エクセルの時刻のカウントが出...
-
基準日以前のデータを範囲を指...
-
EXCELで日付を比べ3か月以内の...
-
マクロで行の高さを設定したい
-
エクセル関数について
-
文字列を比較し、相違するフォ...
-
エクセル関数について
-
excel / ピポッド 日数を出したい
-
エクセル VBA 行間隔を飛ばした...
-
時間の重複チェック
-
プルダウンに【なし、平均、デ...
-
EXCEL 最終行のデータを他のセ...
-
列と行の名前(重複あり)が交...
おすすめ情報