エクセル2007でマクロを作成頂けませんでしょうか。

気持ちだけではありますが、一番最初に完全に動作するマクロを作成頂いた方に200p差し上げます。

AA-CH:3列ごとに数字/文字/数字に区切られている。

(例:AA/001 , AB/Brand"001", AC/5 1/2列目は一対一対応)

AA-CHまで3列に区切った1列目の数字が小さい方を優先し、かつ列で

数字をあわせて(同一数字がなければ3列毎に空欄に)3列毎に並びかえ。

(区切った1列目の数字が同一の数字になるようにする)

よろしくお願いいたします。

http://d.hatena.ne.jp/bamboodragon/20100804/1280898402

回答の条件
  • 1人2回まで
  • 13歳以上
  • 登録:2010/08/04 14:08:35
  • 終了:2010/08/04 22:04:41

回答(3件)

id:yamaneroom No.3

yamaneroom回答回数1040ベストアンサー獲得回数612010/08/04 16:11:36

Sub Macro()
    Dim i As Long
    Dim c As Long
    Dim r As Long
    Dim lastRow As Long
    Dim minNum As Long
    
    lastRow = Cells(Rows.Count, "AA").End(xlUp).Row
    
    For i = 1 To lastRow
        Columns("IT:IT").NumberFormatLocal = "@"
        r = 1
        For c = 27 To 84 Step 3
            Cells(r, "IT").Value = Cells(i, c).Value
            Cells(r, "IU").Value = Cells(i, c + 1).Value
            Cells(r, "IV").Value = Cells(i, c + 2).Value
            r = r + 1
        Next c
        Range("IT:IV").Sort Key1:=Range("IT1"), Order1:=xlAscending, Header:= _
            xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            SortMethod:=xlPinYin, DataOption1:=xlSortNormal
        
        r = 1
        For c = 27 To 84 Step 3
            Cells(i, c).Value = Cells(r, "IT").Value
            Cells(i, c + 1).Value = Cells(r, "IU").Value
            Cells(i, c + 2).Value = Cells(r, "IV").Value
            r = r + 1
        Next c
        
        Columns("IT:IV").Clear
    Next i
    
    c = 27
    Do
        minNum = 1000
        For i = 1 To lastRow
            If Cells(i, c).Value <> "" Then
                If Cells(i, c).Value < minNum Then
                    minNum = Cells(i, c).Value
                End If
            End If
        Next i
        
        If minNum = 1000 Then
            Exit Do
        Else
            For i = 1 To lastRow
                If Cells(i, c).Value <> minNum And Cells(i, c).Value <> "" Then
                    Range(Cells(i, c), Cells(i, c + 2)).Insert Shift:=xlToRight
                End If
            Next i
        End If
        
        c = c + 3
    Loop
End Sub
  • id:windofjuly
    うぃんど 2010/08/04 14:28:17
    SALINGER さんのコードで問題ないようであれば、またポイント目当ての回答者が寄ってくる前に、この質問はキャンセルしたほうが得策かもしれません
    とりあえず「受け付け停止」でもいいでしょう
     
    ポイントをお送りしたいのであればSALINGERさんのプロフィールページの右にある「ポイント付きメッセージを送信する」から直接送ることが可能です
    手数料は5%ですが、これは人力で質問した場合の手数料と同じです。違いがあるとすれば SALINGER さんの受け取ったポイントが表にでるかでないか(回答欄であれば受け取ったポイントが表示されてますが直接送信は本人同士しかわかりません)という点です
    http://www.hatena.ne.jp/SALINGER/
  • id:SALINGER
    あれ、なぜに私が書いたコードと一字一句同じコードをyamaneroomが回答してるの?
    >bamboodragonさん
    この質問はパクリ回答の人はともかく他の回答も悪い事を覚えた子供のようですから思いっきりキャンセルしてあげてください。
    今回はこれを含め3回同じ質問でポイントを使ってしまったと思うのでポイントはいいですよ。
    別の質問が立ったときにはりきって回答させていただきます。
  • id:bamboodragon
    >windofjulyさん
    コメント有難う御座います。モラルを疑うような書き込みってあるのですね。思う壺なので過度な反応はしませんが。
    いろいろ「はてな」について色々ご教授いただき、有難う御座います。もしwindofjulyさんの時間が許せば、
    また色々とご教授頂けると幸甚です。

    >SALINGERさん
    ご配慮いただき有難う御座います。

    ただ、今回の件についてはSALINGERさんに瑕疵はなく、「はてな」に関する私の知識不足が問題で
    お手数をおかけしただけです。(モラルを疑う回答は論外ですが)

    気が済みませんので受け取ってください。

    ポイントについてはwindofjulyさんに教えていただいた方法でお送りしたつもりですが、
    受け取っていただけたか、こちらからでは確認できないためここに書き込みさせていただきます。
    何かありましたらご連絡ください。
  • id:SALINGER
    確かに受け取りました。ありがとうございます。

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

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

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

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