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

http://hatena88.web.fc2.com/hatena/newpage1.shtml
なお、現在勉強中ですので、下記の質問の回答者4の方のような解説を付け加えてください。
http://q.hatena.ne.jp/1158311664

回答の条件
  • URL必須
  • 1人2回まで
  • 登録:2007/01/25 17:28:08
  • 終了:2007/01/26 14:13:59

回答(3件)

id:kn1967 No.1

kn1967回答回数2915ベストアンサー獲得回数3012007/01/25 18:31:35

ポイント40pt

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


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

(1)設定というシートを作成

(2)列を指定させる

(3)指定された列すべてを設定シートのA列にコピー

(4)設定シートのA列をソート

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


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

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


(1)~(3)に関しては、

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: 'シート選択

に変えます。


(4)は

最後の

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

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

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

に変えます。


(5)は(4)の下に

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

Do

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

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

  End If

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

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

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


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

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

id:taroemon

ご回答ありがとうございます。

できればできあがった物を提示していただけると助かります。

ただご指摘、ご指導には感謝します。

2007/01/25 18:36:13
id:takashi_m17 No.2

たか回答回数104ベストアンサー獲得回数122007/01/26 11:33:19

ポイント200pt
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/

id:taroemon

ご回答ありがとうございます。

完璧に出来ました。

また機会がありましたら、

よろしくご回答下さいませ。

2007/01/26 14:13:18

質問者が未読の回答一覧

 回答者回答受取ベストアンサー回答時間
1 cutie17 343 268 6 2007-01-26 02:38:37
  • id:uzumaki7
    話はそれるけど、Dim i, j As Integerって書き方では、jはintegerに宣言されるけど、iは何も宣言されてない状態variantになるんじゃなかったっけ?

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません