Excel VBA特定の出会いに基づいて行を削除する

Question

私はその間に数値とテキストを含むExcelシートを持っています。 私が欲しいのは、 "Precipitable"に出会うまで "Station"で始まる完全な行を削除することです。 私はこれを初めて習得し、オンラインで利用可能なコードを試しましたが、成功できませんでした。

は、例えばデータが見えるように：

PRES HGHT TEMP DWPT RELH MIXR DRCT SKNT THTA THTE THTV 
hPa  m  C  C  % g/kg deg knot  K  K  K 
--------------------------------------------------------------------------- 
1002.0 14 28.4 25.3 83 20.78  45  2 301.4 363.0 305.1 
1000.0 34 28.2 25.2 84 20.69  45  2 301.4 362.7 305.1 
969.9 304 25.6 23.6 89 19.36 330  7 301.4 358.7 304.9 
940.0 581 23.0 22.0 94 18.07 330  9 301.4 354.9 304.7 
937.0 609 22.8 21.8 94 17.84 330  9 301.5 354.3 304.7 
920.0 769 21.8 20.3 91 16.59 335  10 302.1 351.2 305.1 
904.8 914 21.8 18.9 84 15.47 340  11 303.5 349.6 306.3 
850.0 1458 21.8 13.8 60 11.80  25  11 309.0 345.1 311.2 
795.0 2039 21.8 8.8 43 9.02  34  8 314.9 343.4 316.6 
786.3 2133 21.1 8.1 43 8.66  35  7 315.1 342.6 316.8 
700.0 3125 13.2 0.2 41 5.58  79  9 317.1 335.2 318.1 
685.0 3307 11.6 -1.4 40 5.07  87  9 317.3 333.8 318.2 
623.0 4090 2.6 -1.2 76 5.66 122  10 315.7 333.9 316.8 
600.0 4394 0.8 -3.9 71 4.80 137  11 317.0 332.7 317.9 
590.0 4529 0.0 -4.1 74 4.81 143  11 317.6 333.3 318.5 
577.0 4708 -1.1 -4.6 77 4.74 151  11 318.3 333.9 319.2 
549.0 5108 0.5 -1.1 89 6.47 170  12 324.8 346.3 326.1 
500.0 5850 -7.3 -11.9 70 3.09 205  13 324.1 334.7 324.7 
484.5 6096 -7.0 -17.1 44 2.08 220  13 327.4 334.8 327.9 
474.0 6267 -6.7 -20.7 32 1.56 223  13 329.8 335.5 330.1 
457.0 6552 -7.5 -21.5 32 1.51 228  13 332.3 337.8 332.6 
400.0 7580 -12.7 -26.7 30 1.08 245  12 338.4 342.5 338.6 
357.0 8444 -16.5 -28.5 35 1.03 174  10 344.5 348.5 344.7 
300.0 9730 -26.3 -37.3 35 0.52  65  6 348.2 350.3 348.3 
250.0 11020 -36.5 -46.5 35 0.24  85  5 351.7 352.7 351.7 
200.0 12530 -49.1 -58.1 34 0.07 135  8 354.9 355.2 354.9 
170.0 13577 -57.1          358.4   358.4 

局情報とサウンディングインデックス

      Station identifier: VABB 
          Station number: 43003 
          Observation time: 730602/0000 
          Station latitude: 19.11 
          Station longitude: 72.84 
          Station elevation: 14.0 
          Showalter index: -2.44 
           Lifted index: -7.32 
    LIFT computed using virtual temperature: -8.10 
           SWEAT index: 224.58 
            K index: 29.90 
         Cross totals index: 21.10 
         Vertical totals index: 29.10 
         Totals totals index: 50.20 
     Convective Available Potential Energy: 1252.58 
      CAPE using virtual temperature: 1440.95 
         Convective Inhibition: -0.01 
      CINS using virtual temperature: 0.00 
        Level of Free Convection: 943.36 
      LFCT using virtual temperature: 944.28 
        Bulk Richardson Number: 237.98 
      Bulk Richardson Number using CAPV: 273.77 
    Temp [K] of the Lifted Condensation Level: 296.48 
Pres [hPa] of the Lifted Condensation Level: 944.28 
    Mean mixed layer potential temperature: 301.39 
       Mean mixed layer mixing ratio: 19.57 
       1000 hPa to 500 hPa thickness: 5816.00 
Precipitable water [mm] for entire sounding: 52.16 

---------------------------------------------------------------------------- 
PRES HGHT TEMP DWPT RELH MIXR DRCT SKNT THTA THTE THTV 
hPa  m  C  C  % g/kg deg knot  K  K  K 
---------------------------------------------------------------------------- 
1000.0 14 32.4 26.4 71 22.27 270 12 305.6 372.9 309.6 
967.9 304 25.8 21.9 79 17.42 310 10 301.8 353.4 304.9 
961.0 368 24.4 20.9 81 16.48 310 10 300.9 349.6 303.9 
935.0 609 26.1 20.2 70 16.27 310 11 305.0 353.9 308.0 
933.0 628 26.2 20.2 70 16.25 310 11 305.3 354.2 308.3 
903.0 914 25.2 18.3 65 14.88 315 7 307.2 352.4 310.0 

Answer 1

このコードは、下から、行を削除開始します最初の列の最初の単語として "Precipitable"が見つかったとき。最初の単語として「ステーション識別子：」という単語が見つかると停止します。

Sub Main() 

Dim rowCount As Long 
Dim counter As Long 
Dim delete As Boolean 
Dim s As String 

rowCount = Cells(Rows.Count, 1).End(xlUp).Row 

For counter = rowCount To 1 Step -1 

    s = Cells(counter, 1).Value 

    If Left(s, InStr(s, " ")) = "Precipitable" Then  
     delete = True   
    End If 

    If Left(s, InStr(s, " ")) = "Station identifier:" Then  
     deleteRow (counter)   
     delete = False   
    End If 

    If (delete) Then  
     deleteRow (counter)  
    End If  

Next counter 

End Sub 
'------------ 
Sub deleteRow(counter As Long) 
    Cells(counter, 1).EntireRow.delete 
End Sub