下記のようなExcelの表があります。
コードA コードB 本文 言語 図面種類 図面名
1 a 123 J tif a.tif
2 b 456 E pdf b.pdf
3 c 789 J gif c.gif
4 a 145 E eps a_1.eps
5 d 235 E tif d.tif
6 c 467 E pdf c_1.pdf
7 a 345 J gif a_2.gif
これを、コードBが重複する行があれば、行の中の言語、図面種類、図面名をコードAが一番早い数字の最終列に移動するVBAを作成したいと思っています。
コードA コードB 本文 言語 図面種類 図面名 言語 図面種類 図面名 言語 図面種類 図面名
1 a 123 J tif a.tif E eps a_1.eps J gif a_2.gif
2 b 456 E pdf b.pdf
3 c 789 J gif c.gif E pdf c_1.pdf
5 d 235 E tif d.tif
7 a 345 J gif a_2.gif
検索して下記のページを見つけ、いろいろ調べて変更してみたのですが、Cellsの指定方法がよくわからず、先に進めません。
どのようにしたら上記の結果を表示できるか、お助け頂けないでしょうか?
http://okwave.jp/qa552017.html
Sub transform()
Dim x As Integer
Dim y As Integer
y = 3 '先頭のデータの行
Do Until Cells(y + 1, 2).Value = "" '重複セルの列の値が空になるまでループする
y = y + 1
If Cells(y, 2).Value = Cells(y - 1, 2).Value Then
x = Cells(y - 1, 2).End(xlToRight).Column + 1 '最終列の隣に追加
Cells(y - 1, x).Value = Cells(y, 2).Value
Cells(y, 2).EntireRow.Delete
y = y - 1
End If
Loop
End Sub
No.1
- 回答日時:
リンク先の回答の場合は、比較したいデータが並んでいる時には使えますが、
提示されている表の様子からだと、ちょっと違うように思います。
>コードBが重複する行があれば、行の中の言語、図面種類、図面名をコードAが一番早い数字の最終列に移動する
だとすると、
>7 a 345 J gif a_2.gif
は
>1 a 123 J tif a.tif E eps a_1.eps J gif a_2.gif
ここに来るはずですが・・・?
間違えか、条件が別にあるのか、不明です。
あと、コードAは昇順に並んでいると言う事でしょうか?
回答ありがとうございます!
ご指摘の通り、7は消し忘れです。
混乱させてしまい申し訳ありません…。
コードAは昇順に並んでいます。
No.2
- 回答日時:
提示されたVBAを少し作り直してみました。
何かの参考になれば幸いです。
Sub transform()
Dim x As Integer
Dim y As Integer
y = 3 '先頭のデータの行
Do Until Cells(y + 1, 2).Value = "" '重複セルの列の値が空になるまでループする
If Cells(y, 2).Value = Cells(y + 1, 2).Value Then
x = Cells(y, 256).End(xlToLeft).Column + 1 '最終列の隣に追加
Cells(y, x) = Cells(y + 1, 2)
Cells(y + 1, 2).EntireRow.Delete
Else
y = y + 1
End If
Loop
End Sub
回答ありがとうございます!
試してみましたが、図面種類などは追加されず、右側に1つずつコードBが追加されたのみでした。
でも、考えて下さってありがとうございました!
No.3
- 回答日時:
問題は>コードBが重複する行があれば
の重複をどういう風にVBAコードでに検出するかにある。
この点がポイントなのに、検討した形跡が見られない。確かにプログラムの多数の経験がなければ、1-2時間考えても、そう浮かんでこないでしょうが。
これも他人の回答を見習うより他無いのだろう。
ーーー
(1)ソート法
(2)カウント法
(3)Find法
など思い浮かぶ。
(1)はB列でソートすると例えばaの行は固まる。その状態を使う。
ロジックは一番簡単になるでしょう。
(3)はB列でaを見つけるFindメソッドを発行し、見つかれば所定の
処理をし、見つかった次の行以下を対象に、aを見つけるFindメソッドを発行し、最終まで繰り返す。ただ見つかった行をまた
検索しないような仕掛けが必要です。少し複雑。
==
例データ B1:C10
aX
sY
xV
cW
dZ
aT
dS
aR
fQ
cP
ーーー
コード
Sub test01()
d = Range("B65536").End(xlUp).Row
For i = 1 To d
x = Application.WorksheetFunction.CountIf(Range("B1:B" & i), Range("B" & i))
If x > 1 Then
' 重複行の下の行探知
y = Application.WorksheetFunction.Match(Range("B" & i), Range("B1:B100"), 0)
c = Range("az" & y).End(xlToLeft).Column '右端列の探知
Cells(y, c + 1) = Cells(i, "B").Offset(0, 1) '隣列データ
End If
Next i
'---重複行削除
For i = d To 1 Step -1
x = Application.WorksheetFunction.CountIf(Range("B1:B" & i), Range("B" & i))
If x > 1 Then
Cells(i, "B").EntireRow.Delete
End If
Next i
End Sub
上記はC列1列しか右へ累積していないので、質問のためには手直し必要。言語、図面種類、図面名の3列づつ(3列分)移す(累積する)ように手直しが必要。
ちょっと危ないロジックかなと思うので、ソート法を薦めます。
ーー
結果
B列 C列 D列 E列(C列以右列に累積)
aXTR
sY
xV
cWP
dZS
fQ
回答ありがとうございます!
ご指摘の通り、プログラムの経験がほとんどなく、VBAも今回が初めてと言っていいほどです。
Cellsの値を検討してみたのですが全くうまくいかず、結局元に戻して掲載しました…。
いろいろと考え方を提示くださってありがとうございます。
とても参考になりました。
No.4ベストアンサー
- 回答日時:
7行目は削除されるでいいのかな?
Sub sample()
Dim r As Long
r = 2
Do While Cells(r, 2) <> ""
If WorksheetFunction.CountIf(Range("B2").Resize(r - 1, 1), Cells(r, 2)) > 1 Then
Cells(r, 4).Resize(1, 3).Copy Destination:=Cells(Range("B1").Resize(r, 1).Find(Cells(r, 2)).Row, Columns.Count).End(xlToLeft).Offset(0, 1)
Rows(r).Delete
Else
r = r + 1
End If
Loop
End Sub
回答ありがとうございます!
7行目は削除されるで問題ありません!
スクリプトを実行してみたら、見事できました。
この2日くらいずっと悩んでいたので、エラーなく動作をしているのを見て感動してしまいました。
またスクリプトの中のRangeオブジェクト、Copy Destinationなどを検索していたら、とても参考になるサイトも見つけられました。
とても助かりました。本当に、ありがとうございます!!
No.5
- 回答日時:
Sub try()
Dim Dic As Object
Dim i As Long, j As Long
Dim k As Long, m As Integer, Max_col As Integer
Dim v, vv
Set Dic = CreateObject("Scripting.Dictionary")
With Worksheets("Sheet1")
v = .Range(.[A3], .Cells(Rows.Count, 1).End(xlUp).Resize(, 6)).Value
End With
ReDim vv(1 To UBound(v, 1), 1 To 256)
For k = 1 To UBound(v, 1)
If Not Dic.Exists(v(k, 2)) Then
i = i + 1
For m = 1 To 6
vv(i, m) = v(k, m)
Next
Dic(v(k, 2)) = Array(i, 6)
Else
For m = 1 To 3
vv(Dic(v(k, 2))(0), Dic(v(k, 2))(1) + m) = v(k, m + 3)
Next
Dic(v(k, 2)) = Array(Dic(v(k, 2))(0), Dic(v(k, 2))(1) + 3)
If Max_col < Dic(v(k, 2))(1) Then Max_col = Dic(v(k, 2))(1)
End If
Next
With Worksheets("Sheet2")
.Cells.ClearContents
.Range("A3").Resize(Dic.Count, UBound(vv, 2)).Value = vv
.Range("A2").Resize(, 6).Value = Worksheets("Sheet1").Range("A2").Resize(, 6).Value
.Range("D2").Resize(, 3).AutoFill Destination:=Range("D2").Resize(, Max_col - 3),
Type:=xlFillDefault
End With
Erase v, vv
Set Dic = Nothing
End Sub
回答ありがとうございます!
こちらは新しいワークシートにデータを移行する方法ですね。
こちらもとても参考になりました。
ありがとうございます!!
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
このQ&Aを見た人はこんなQ&Aも見ています
-
ちょっと先の未来クイズ第2問
9月9日(月)に発表される「第3回子どもマネー川柳」に入賞する川柳を考えてこちらに投稿してください。
-
フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
あなたが普段思っている「これまだ誰も言ってなかったけど共感されるだろうな」というあるあるを教えてください
-
映画のエンドロール観る派?観ない派?
映画が終わった後、すぐに席を立って帰る方もちらほら見かけます。皆さんはエンドロールの最後まで観ていきますか?
-
海外旅行から帰ってきたら、まず何を食べる?
帰国して1番食べたくなるもの、食べたくなるだろうなと思うもの、皆さんはありますか?
-
天使と悪魔選手権
悪魔がこんなささやきをしていたら、天使のあなたはなんと言って止めますか?
-
EXCELのVBAで、重複データを隣のセルへ移動したい
Access(アクセス)
-
EXCELである列を上から順にチェックし、重複値がある場合に一方のデータを移動する方法
Excel(エクセル)
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・人生のプチ美学を教えてください!!
- ・10秒目をつむったら…
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・【大喜利】【投稿~9/18】 おとぎ話『桃太郎』の知られざるエピソード
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
1/500から1/300にする 何倍で...
-
図面1/70スケールを1/50にする...
-
図面などにて出てくる「m/m」は...
-
勝手反対って何でしょうか?
-
建築図面記号でアの文字が外周...
-
【塗装関係】SCL塗とは?
-
家の図面で四角の中に実線でバ...
-
ペイントで 点線を 描くには...
-
図面に記載のPA、PB
-
図面と現況が異なる場合、現況...
-
真面目な相談です。住宅工務店...
-
Wordに図面を貼り付けると...
-
エレベータのフィッシャープレ...
-
縮尺1/100の図面の寸法が表...
-
住宅地図は真北?磁北?
-
給排水の図面がない場合
-
住宅工務店に詳しい方!! ご回...
-
図面で筋交いを表す記号について。
-
真面目な相談です。住宅工務店...
-
図面の見方
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
図面などにて出てくる「m/m」は...
-
1/500から1/300にする 何倍で...
-
勝手反対って何でしょうか?
-
図面の縮尺から実寸を計算する方法
-
建築図面記号でアの文字が外周...
-
家の図面で四角の中に実線でバ...
-
図面1/70スケールを1/50にする...
-
図面に記載のPA、PB
-
青焼き機白焼き機とは???
-
エレベータのフィッシャープレ...
-
ペイントで 点線を 描くには...
-
住宅地図は真北?磁北?
-
図面で筋交いを表す記号について。
-
Wordに図面を貼り付けると...
-
住宅工務店に詳しい方!! ご回...
-
真面目な相談です。住宅工務店...
-
真面目な相談です。住宅工務店...
-
SFHの意味
-
板厚の表記方法
-
図面に真北をどうやって写すの?
おすすめ情報