エクセルVBAについて質問です。次のページにあるような２つのマクロを作ってください。

＞同一の文字列が２個以上あった場合、最後尾に「設定」というシートが作成され

手順を少し変えると楽になります。

（１）設定というシートを作成

（２）列を指定させる

（３）指定された列すべてを設定シートのＡ列にコピー

（４）設定シートのＡ列をソート

（５）一番下のセルを選択して、それよりも上に同じものがあれば削除、１つ上のセルを選択して、それよりも、、、以下同文というループ

この方法であれば前回ご質問の回答２　

http://q.hatena.ne.jp/1169694559　を少し改造するだけです。

（１）～（３）に関しては、

S_Range = "A:E": 'ここではA列からE列と設定

という一行を

S_Range = InputBox("A:AやB:Bの形で列を入力してください")

という一行に変えてダイアログボックスを出すようにします。

そして、

Sheets(Sheets.Count).Name = "合計": 'シート見出し

を

Sheets(Sheets.Count).Name = "設定": 'シート見出し

に、

Sheets("合計").Select: 'シート選択

も

Sheets("設定").Select: 'シート選択

に変えます。

（４）は

最後の

　　obj_Sheets.Select: '元もと選択されていた状態に戻す

の必要性がなくなりましたので消して、

　　Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod :=xlPinYin

に変えます。

（５）は（４）の下に

Cells(65535, 1).End(xlUp).Select:'最下行に移動

Do

　　If Activecell.Value = Activecell.Offset(-1,0).Value Then'１つ上のセルと同じ内容なら

　　　　Activecell.Value = "":'空っぽにする

　　End If

loop while Activecell.Row > 1:'１行目に達していなければDoに戻る

Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod :=xlPinYin

最後にもう一度ソートすれば虫食いがなくなる。

以上、いきなり書いてますので記述ミスがあるかもしれませんが、学習中ということで、改造にチャレンジしてみて下さい。

なお、マクロ２は前回ご質問の回答１の改造で対応可能です。

Sub マクロ1()
    Dim st, st2         As Worksheet
    Dim y, y2, x, x2, z As Integer
    Dim h_for, h_sheet  As Integer
    Dim ny              As Integer
    Dim WSN()           As String
    Dim i, j            As Integer
'st,x,yをメイン、st2,x2,y2を判定用とします

'##### 初期設定 ########################################
    h_for = 0   'for文の判定に使用
    h_sheet = 0 '設定シートの有無に使用(1=有,0=無)
    ny = 1      '設定シートの入力行開始位置(1=1行目)
    nx = 1      '設定シートの入力列開始位置(1=A列)
    x = 2       'データシートの指定する列(2=B列)
    
'##### 全シート選択処理 ################################
    i = Worksheets.Count        'シート数をカウント
    ReDim WSN(1 To i)           'シート名の変数の数を設定
    For j = 1 To i
        WSN(j) = Sheets(j).Name 'シート名を変数に格納
    Next

'##### メイン処理 ######################################
'全シートを一つずつstに返し、以下の処理を繰り返します
    For Each st In Sheets(WSN)
        st.Select
        
'データが100行になるか空白になるまで繰り返します(100は可変）
        For y = 1 To 100
            If (st.Cells(y, x) = "") Then
                Exit For
            End If
            
'判定用に全シート、100行までチェックします(100は可変)
            For Each st2 In Sheets(WSN)
                For y2 = 1 To 100
                    If (st2.Cells(y2, x) = "") Then
                        Exit For
                    End If

'メインと判定用が全く同じ場所をチェックするのを防ぎます
                    If (y = y2 And st.Name = st2.Name) Then
                    Else
                    
'メインと判定用が同じであるかチェックします
                        If (st.Cells(y, x) = st2.Cells(y2, x)) Then
                        
'「設定」シートの有無をチェックし、なければ一番最後にシートを追加します
                            If (h_sheet = 0) Then
                                Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
                                ActiveSheet.Name = "設定"
                                h_sheet = 1
                            End If
                            
'「設定」シートに既に同じものがないかチェックします（2重書き込みの防止）
                            For z = ny To 100
                                If (Sheets("設定").Cells(z, 1) = st.Cells(y, x)) Then
                                    Exit For
                                End If

'「設定」シートの入力開始行から空白になる所にデータをコピーします
                                If (Sheets("設定").Cells(z, 1) = "") Then
                                    Sheets("設定").Cells(z, nx) = st.Cells(y, x)
                                    Exit For
                                End If
                            Next
                            h_for = 1
                            Exit For
                        End If
                    End If
                Next

'1つコピーが完了すればメインデータを次の行にいく為、forを抜けます
                If (h_for = 1) Then
                    h_for = 0
                    Exit For
                End If
            Next
        Next
    Next
    Sheets("設定").Select
End Sub

Sub マクロ2()
    Dim x, x2, x3, y, y2 As Integer
    Dim WSN()            As String
    Dim i, j             As Integer
    Dim st               As Worksheet
    
'##### 初期設定 ########################################
    x = 1           '設定シートのデータ位置(1=A列)
    x2 = 2          'データシートの指定する位置(2=B列)
    x3 = 4          'データシートの「別の列」位置(4=D列)
    
'##### 全シート選択処理 ################################
    i = Worksheets.Count
    ReDim WSN(1 To i)
    For j = 1 To i
        WSN(j) = Sheets(j).Name
    Next

'##### メイン処理 ######################################
'「設定」シートのデータ位置が100行、もしくは空白になるまで繰り返します
    For y = 1 To 100
        If (Sheets("設定").Cells(y, x) = "") Then
            Exit For
        End If
        
'設定シート以外、全シート処理を繰り返します
        For Each st In Sheets(WSN)
            If (st.Name = "設定") Then
                Exit For
            End If
            
'データシートのデータが100行、もしくは空白になるまで繰り返します
            For y2 = 1 To 100
                If (st.Cells(y2, x2) = "") Then
                    Exit For
                End If
                
'設定シートのデータとデータシートのデータが同じであれば
                If (st.Cells(y2, x2) = Sheets("設定").Cells(y, x)) Then
                
'設定シートのデータの隣（マニュアルで入力する列）をデータシートの指定位置にコピーします
                    st.Cells(y2, x3) = Sheets("設定").Cells(y, x + 1)
                End If
            Next
        Next
    Next
End Sub

http://www.hatena.ne.jp/