前提・実現したいこと
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列のアンカーの数字を置換
コレをループしてアンカーを修正していく マクロをコピペできるようにしてほしいです。
-
気になる質問をクリップする
クリップした質問は、後からいつでもマイページで確認できます。
またクリップした質問に回答があった際、通知やメールを受け取ることができます。
クリップを取り消します
-
良い質問の評価を上げる
以下のような質問は評価を上げましょう
- 質問内容が明確
- 自分も答えを知りたい
- 質問者以外のユーザにも役立つ
評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。
質問の評価を上げたことを取り消します
-
評価を下げられる数の上限に達しました
評価を下げることができません
- 1日5回まで評価を下げられます
- 1日に1ユーザに対して2回まで評価を下げられます
質問の評価を下げる
teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。
- プログラミングに関係のない質問
- やってほしいことだけを記載した丸投げの質問
- 問題・課題が含まれていない質問
- 意図的に内容が抹消された質問
- 広告と受け取られるような投稿
評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。
質問の評価を下げたことを取り消します
この機能は開放されていません
評価を下げる条件を満たしてません
質問の評価を下げる機能の利用条件
この機能を利用するためには、以下の事項を行う必要があります。
- 質問回答など一定の行動
-
メールアドレスの認証
メールアドレスの認証
-
質問評価に関するヘルプページの閲覧
質問評価に関するヘルプページの閲覧
+1
まず、あからさまなマルチポストに驚きました。
マルチポストがマナー違反であるということ、もしくはマルチポストという言葉自体ご存知ないのではないでしょうか？
なぜマルチポストが悪とされるのかはこちらを参照ください。
⇒マルチポストについて
＞エクセル VBA マクロについてご質問いたします。
質問とありますが、質問の本題はどこでしょうか？
最終的に「作ってもらったコードをコピペしたい」というのが本題なら、それは質問ではなくおねだりであり、「やってほしいことだけが書かれた丸投げの質問」はTetatailでは推奨されていません。
「思考するエンジニアのためのQAプラットフォーム」という意味を今一度考えてみてください。
コードを追記いただいたようですが、これは今回の目的を実現するために自分で作成したコードでしょうか？
どこにもアンカーを探している形跡がありませんし、行番号-2で連番となるF列を作成しているところから察するに、どちらかというと今回のデータソースとなるシートを作成するためのコード？のように見えます。
まずはわからないなりにも、できるところまでご自身で手を動かして作ってみてください。
実際に物を作ろうとしてその入口で躓いたとしても、今回のような質問にはならないはずです。
手を動かして、（丸投げでない）もっと具体的な質問がでてきたら、もう一度ここで質問してみてください。
その時はご協力できると思います。
投稿
-
回答の評価を上げる
以下のような回答は評価を上げましょう
- 正しい回答
- わかりやすい回答
- ためになる回答
評価が高い回答ほどページの上位に表示されます。
-
回答の評価を下げる
下記のような回答は推奨されていません。
- 間違っている回答
- 質問の回答になっていない投稿
- スパムや攻撃的な表現を用いた投稿
評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。
質問への追記・修正、ベストアンサー選択の依頼
hajimete
2017/03/10 13:45
やってほしいことはダメなんですか？
hajimete
2017/03/10 13:46
リンク先にちゃんと記載されていますよ。
2017/03/10 13:38
複数のユーザーから「やってほしいことだけを記載した丸投げの質問」という意見がありました
「質問を編集する」ボタンから編集を行い、調査したこと・試したことを記入していただくと、回答が得られやすくなります。
ttyp03
2017/03/10 14:35
こちらをご覧ください。https://teratail.com/help/avoid-asking 特にこの文面です。「まずは実際に作業に取り組み、つまづいたところで投稿をしてみてください。」