下記の内容のように列の並び替えを行っておりますが、重複した項目名が存在

質問

下記の内容のように列の並び替えを行っておりますが、重複した項目名が存在すると一番最後に存在する項目名（"データ"）を引っ張ってきてしまいます。作業としては、

1つ目の"データ"内容　⇒　3桁の文字列
2つ目の"データ"内容　⇒　2桁の文字列

をマクロの初めに"データ(3桁)"、"データ(2桁)"と項目名を変更してから並び替えをしたいと思っています。重複行や重複列の削除は検索でヒットするのですが、上記作業工程が書けません。どなたか教えてください。

Sub sample()
Dim fld As Variant
Dim rng As Range
Dim c As Integer
Sheets("Sheet2").Cells.Clear
c = 1
For Each fld In Array("データ", "電話", "学校名", "住所", "データ"）
Set rng = Rows(1).Find(fld, LookAt:=xlWhole)
If rng Is Nothing Then
MsgBox fld & " なし"
Exit Sub
Else
rng.EntireColumn.Copy Sheets("Sheet2").Cells(1, c)
c = c + 1
End If
Next
End Sub

回答No.1

imogasi

質問の意味が明確でない。
データ実例（見出しも含めて）をしめして質問しないからだと思う。
ーー
第１行が見出し行と仮定して
A列　　B列　　C列　　D列
データ　所属　データ　計数
以下２行目から実際数値や文字列がある場合
A列の見出しをデータ（3桁)
C列の見出しをデータ（2桁)
に変えたいだけなら
Sub test01()
rc = Range("IV1").End(xlToLeft).Column
MsgBox rc
midasi = Array("データ(3桁)", "データ(2桁)")
j = 0
For cl = 1 To rc
MsgBox Cells(1, cl)
If Cells(1, cl) = "データ" Then
Cells(1, cl) = midasi(j)
j = j + 1
Else
End If
Next
End Sub
と簡単なことだが。
他にも、コードの書き方は色々あろう。For Eachを使うなど。
Arrayの中は実情の見出し、その「データ」となっている見出し列の数、データにあわせて変えてください。
見出しデータの数が、０、１列の場合や３つ以上の場合のチェックは省いています。Nextを抜けたところのｊの数で、注意コメントは出せるでしょう。