[[20250101190315]]　『このマクロを修正してほしいです』（ひろ）　ページの最後に飛ぶ

『このマクロを修正してほしいです』（ひろ）

いつもお世話になってます
https://sports.yahoo.co.jp/keiba/race/list/25070101
をエクセルのシートにコピーペーストして以下のマクロを実行した所

    Sub 登録馬テスト()

    '
    ' Macro4 Macro
    Dim max_row As Long
    Dim min_row As Long
    '開始行と最終行の行番号取得
    min_row = Worksheets("マクロ前").UsedRange.Row
    max_row = Worksheets("マクロ前").UsedRange.Rows.Count - min_row - 1
      Application.ScreenUpdating = False
    Dim cnt As Long
    Dim r As Long
    Dim レース番号 As Variant
    Dim レース名 As Variant
    Dim 時刻 As Variant
    Dim 日付 As Variant
    Dim 距離 As Variant
    Dim shp As Shape
    cnt = 1

        For r = min_row To max_row

     If Worksheets("マクロ前").Cells(r, 1).Value Like "*R" Then
    'データ取得

    レース番号 = Worksheets("マクロ前").Cells(r, 1).Value
    レース名 = Worksheets("マクロ前").Cells(r, 2).Value
    時刻 = Worksheets("マクロ前").Cells(r + 1, 2).Value
    日付 = Worksheets("マクロ前").Cells(r - 12, 1).Value
    Worksheets("書き出し").Cells(cnt, 3).Value = レース番号
    Worksheets("書き出し").Cells(cnt, 4).Value = レース名
    Worksheets("書き出し").Cells(cnt, 5).Value = 時刻
    Worksheets("書き出し").Cells(cnt, 2).Value = 日付
    cnt = cnt + 1

    距離 = Worksheets("マクロ前").Cells(r, 4).Value      '処理B

                 Worksheets("書き出し").Cells(cnt, 8).Value = 距離        '処理B
                 cnt = cnt + 1                                               '処理B
    End If
    Next r
  Sheets("書き出し").Select

          Range("B1").Select
    Selection.Copy
    Range("B1:B7").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("H1").Select
    Selection.Phonetics.Visible = True
    Selection.Delete Shift:=xlUp
    Range("H2").Select
    Selection.EntireRow.Delete
    Range("H3").Select
    Selection.EntireRow.Delete
    Range("H4").Select
    Selection.EntireRow.Delete
        Columns("E:E").Select
    Selection.TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _
        True
 Range("E2:E8").Select
    Selection.Copy
    Range("I2").Select
    ActiveSheet.Paste
    Columns("E:E").Select
    Selection.Replace What:="(*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="*歳", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="*上", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Columns("B:B").Select
    Selection.Replace What:="*年", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Columns("i:i").Select
    Selection.Replace What:="(*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Columns("B:B").Select
    Selection.Replace What:="日", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="（*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="月", Replacement:="/", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Columns("C:C").Select
    Selection.Replace What:="r", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
       Columns("D:D").Select
    Selection.NumberFormatLocal = "G/標準"
    Range("D2").Select
 Application.ScreenUpdating = True

End Sub

９
１０

１１
となってて
それを
９
１０
１１

としたいのですがどうかえたら良いでしょうか
よろしくお願いいたします

＜使用 Excel：Excel2019、使用 OS：Windows10 ＞

そのマクロは自分で作成したものではないですよね。
その作成者に問い合わせたらでどうですか。
（・・・・・） 2025/01/01(水) 19:49:05

■１
新年早々、違っていたらごめんなさいですが、ニックネームや内容から想像して↓の投稿に心当たりは無いですか？

 【過去ログ】
[[20241129180613]]　『こんなマクロを作りたいのですが』（ひろ）
[[20190131212103]]　『２０１９年(・・・)を(から隣のセルに区切りたいのですが』（ひろ）
[[20190130202008]]　『特定の単語の横のセルの値を取得して他のセルに入』（ひろ）
[[20190129114306]]　『特定の列の特定の単語を検索して　その単語の横の列に文字を入れたい』（ひろ）
[[20190121213642]]　『３つのマクロを一つにまとめたい』（ひろ）
[[20190118172923]]　『webクエリで取得した表の処理について』（ひろ）
[[20190114213127]]　『競馬の出馬表処理　サンプルファイル付き』（ひろ）
[[20180302185720]]　『難しい抽出…』（ひろ）

もしも、心当たりがあるようならば、それなりのスキルはあるとおもいますので、何処で詰まっているのか具体的に挙げて質問されてはいかがでしょうか？

■２
いや、心当たりは無く別人だと言うことであれば、マクロの記録で得られたコードのようですから、それぞれの命令の意味を調べて、SelectionやActiveSheetに依存しないように一旦整理してみてはどうですか？

■３
なお、↓だけみれば、処理が終わった後に空白セルを含む行全体を削除して詰めればよいのではないでしょうか？

 ＞ ９
 ＞ １０
 ＞ 
 ＞ １１
 ＞ となってて
 ＞ それを
 ＞ ９
 ＞ １０
 ＞ １１

（もこな２） 2025/01/01(水) 22:17:15

もこな２さんありがとうございます
上の投稿は覚えがありません多分同名の方だと思います
で
行を詰めるコードがわからず困っています

（ひろ） 2025/01/01(水) 23:15:19

■４
そうですか。
具体的にどの部分がわからないのですか？
判定する部分ですか？削除する部分ですか？

前者は、どの列の話かわかりませんが、（下から）順番に見ていけばＯＫでしょう。

   Sub 値が空白なら削除して詰める()
      Dim i As Long

      With ActiveSheet
         For i = .Cells(.Rows.Count, "A").End(xlUp).Row To 1 Step -1
            If .Cells(i, "A").Value = "" Then
               .Rows(i).[削除する命令]
            End If
         Next
      End With
   End Sub

で
後者は【マクロの記録】であたりが付けられるのではありませんか？

（もこな２） 2025/01/02(木) 10:39:45

＞多分同名の方だと思います
本当ですか。嘘ついたらだめですよ。
今回の質問は競馬に関することですよね。
[[20190114213127]]も同様です。
同名の人がそんなことあるわけないでしょ。

（匿名） 2025/01/02(木) 10:47:14

    |[A]     |[B]|[C]                            |[D]         |[E]  |[F]                       |[G]   
 [1]|日付    |R  |レース名                       |コース・回り|距離 |クラス                    |斤量  
 [2]|2025/1/5|  9|鶴舞特別                       |芝・左      |2200m|4歳以上2勝クラス(1000万下)|定量  
 [3]|2025/1/5| 10|門松ステークス                 |ダート・左  |1200m|4歳以上3勝クラス(1600万下)|定量  
 [4]|2025/1/5| 11|スポーツニッポン賞京都金杯?GIII|芝・左      |1600m|4歳以上オープン           |ハンデ

 Sub Macro1()
    Dim v, w, i&, j&, r&
    Dim d As Date
    With Worksheets("マクロ前")
        v = Range(.Cells(1), .Cells(Rows.Count, "B").End(xlUp))
    End With
    w = Application.Transpose(Split("日付 R レース名 コース・回り 距離 クラス 斤量"))
    For i = 1 To UBound(v)
        If Left(v(i, 1), 5) = "2025年" Then d = Split(v(i, 1), "（")(0)
        If v(i, 1) Like "?R" Or v(i, 1) Like "??R" Then
            r = UBound(w, 2) + 1
            ReDim Preserve w(1 To 7, 1 To r)
            w(1, r) = d
            w(2, r) = Replace(v(i, 1), "R", "")
            w(3, r) = v(i, 2)
            For j = 0 To 3
                w(4 + j, r) = Split(v(i + 1, 2))(j)
            Next
        End If
    Next
    Worksheets.Add(after:=Worksheets(Worksheets.Count)) _
        .Cells(1).Resize(UBound(w, 2), 7) = Application.Transpose(w)
 End Sub
（お年玉） 2025/01/02(木) 10:50:51

コメント返信：

[ 一覧(最新更新順) ]

[[20250101190315]] 『このマクロを修正してほしいです』（ひろ） ページの最後に飛ぶ

[[20250101190315]]　『このマクロを修正してほしいです』（ひろ）　ページの最後に飛ぶ