VBA　マクロ　統合

###前提・実現したいこと
http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q13171524818

エクセル VBA マクロについてご質問いたします。

ソースも一応添付させていただきます。
下記２chのスレッド
例）
http://potato.2ch.net/test/read.cgi/mass/1487393683/l50
http://potato.2ch.net/test/read.cgi/mass/1470834229/l50

文章ではうまく説明しずらいのでわからなかったらお聞きください。

説明がわかりずらいと思うのでPDFで画像を送らせていただきます。

A列に数字１と２がランダムで入ってます。それぞれ１と２ではセルの色が違います。

E列に数字が１～1000までランダムに入ってます。

F列にB列のランダムな数字を整列して順番に上から並んでいます。

L列には本文にアンカーといわれるものがついています。
"""""

    '「reg_date」の値を基に昇順に並び替える
    Finr = .Range("B1").End(xlDown).Row
    .Range("A1" & ":AD" & Finr).Sort Key1:=.Range("X1"), order1:=xlAscending, Header:=lYes
  
    
    '列を挿入する
    .Columns("F").Insert
    
    '挿入した列に「=row()-2」を代入
    .Range("F3" & ":F" & Finr).Value = "=row()-2"

    '1行目(各項目名)をSheet2にコピー
    Worksheets("Sheet1").Select
    .Range("A1:AE1").Select
    Selection.Copy
    Worksheets("Sheet2").Select
    Worksheets("Sheet2").Range("A1").Select
    ActiveSheet.Paste
    
    
   '「res_count」列の1行目以降に数値が入っているセルを検索し、入っている行を切り取りSheet2にペースト（次スレ以降のタイトル行を削除）
   DelY = 1
   
   For i = 1 To R

        If Not .Range("O" & DelY & ":O" & Finr).Find(What:="*", LookIn:=xlValues) Is Nothing Then
            
            DelY = .Range("A" & DelY & ":A" & Finr).Find(What:="*", LookIn:=xlValues).Row
                  
            If Len(Trim(DelY)) <> 0 Then
                
               Worksheets("Sheet1").Select
               .Range("A" & DelY & ":AE" & DelY).Select
               Selection.Copy
               
            
               Worksheets("Sheet2").Select
               Worksheets("Sheet2").Range("A" & (i + 1)).Select
               ActiveSheet.Paste
                                 
               Worksheets("Sheet1").Select
               .Range("A" & DelY).Select
               
               If DelY <> 2 Then
               
                Selection.EntireRow.Delete
                DelY = DelY - 1
                   
               Else
               
                .Range("A2").ClearContents

               End If
            
            
            End If
    
    
        End If
    
   Next i
   
   .Range("A2").Value = "1"
   
   Worksheets("Sheet2").Select
   Columns("F").Select
   Selection.Delete
   Range("A1").Select
                
   Worksheets("Sheet1").Select
    
              
    '「status」列に「1」以外の数字が入っている場合は行ごと削除
    i = 2
    Do While i < Finr
    
        If i <= 1 Then
        
            MsgBox "タイトル行(スレッドタイトル、本文)が削除されています！OPEでスレッドタイトル、本文が削除されていないか確認し、データダウンロードからやり直してください"
            Cells.Clear
            Exit Sub
        
        End If
        
        Serc = .Range("R" & i).Value
        
        If Serc = "1" Then
        
            i = i + 1
        
        ElseIf Serc = "" Then
       
            Exit Do
       
        Else
        
            .Rows(i).Delete
            i = i - 1
           
        End If
        
    Loop

"""""
結果
L列に入ってるアンカーをC列で修正された数字に置換する

憶測
L列のアンカー”>>”を検索”>>”から始まる3桁までの数字を取得同時に取得した場所の行の色も取得
取得した数字を検索、同じ行の色ならTRUE 右隣のセルの数字を取得

L列のアンカーの数字を置換

コレをループしてアンカーを修正していくマクロをコピペできるようにしてほしいです。

hajimete

2017/03/10 04:45

やってほしいことはダメなんですか？

hajimete

2017/03/10 04:46

リンク先にちゃんと記載されていますよ。

ttyp03

2017/03/10 05:35

こちらをご覧ください。https://teratail.com/help/avoid-asking 特にこの文面です。「まずは実際に作業に取り組み、つまづいたところで投稿をしてみてください。」

行動規範の内容に同意します

回答1件

まず、あからさまなマルチポストに驚きました。
マルチポストがマナー違反であるということ、もしくはマルチポストという言葉自体ご存知ないのではないでしょうか？
なぜマルチポストが悪とされるのかはこちらを参照ください。
⇒マルチポストについて

＞エクセル VBA マクロについてご質問いたします。
質問とありますが、質問の本題はどこでしょうか？
最終的に「作ってもらったコードをコピペしたい」というのが本題なら、それは質問ではなくおねだりであり、「やってほしいことだけが書かれた丸投げの質問」はTetatailでは推奨されていません。
「思考するエンジニアのためのQAプラットフォーム」という意味を今一度考えてみてください。

コードを追記いただいたようですが、これは今回の目的を実現するために自分で作成したコードでしょうか？
どこにもアンカーを探している形跡がありませんし、行番号-2で連番となるF列を作成しているところから察するに、どちらかというと今回のデータソースとなるシートを作成するためのコード？のように見えます。

まずはわからないなりにも、できるところまでご自身で手を動かして作ってみてください。
実際に物を作ろうとしてその入口で躓いたとしても、今回のような質問にはならないはずです。

手を動かして、（丸投げでない）もっと具体的な質問がでてきたら、もう一度ここで質問してみてください。
その時はご協力できると思います。

投稿2017/03/10 08:40