簡體   English   中英

填充Excel表格中同一列中兩個相等單元格之間的所有空單元格(相等單元格的值相同)

[英]Filling all the empty cells between two equal cells in same column in excel sheet (with the same value of the equal cells )

我有以下excel

原始數據

我正在嘗試以下代碼

> Sub fill_blanks()
 Dim i As Long
 i = 2 '
 Do Until Range("B" & i) = ""
 Range("B" & i).Select
 If ActiveCell.FormulaR1C1 <> "" Then
    Range("A" & i).Select
      If ActiveCell.FormulaR1C1 = "" Then
           Range("A" & i - 1).Copy
           Range("A" & i).PasteSpecial Paste:=xlPasteValues
           Else
           i = i + 1
      End If
    Else
    i = i + 1
  End If
  Loop
End Sub > 

我需要檢查的是單元格是否不為空,然后保持其值,如果為空則檢查同一列中的第一個下一個非空單元格和前一個非空單元格,以及它們是否具有相同的值,然后用相同的值填充它們之間的所有空單元格,如果兩個單元格不匹配,則返回X。

所以結果將如下

我想要的是

但是使用代碼,我得到了一些不同的東西。

這是我用這段代碼得到的

由於我的代碼,我有什么

  1. 找到最后使用的行LastRow以便我們知道在哪里停止。
  2. 循環遍歷你的行,當你遇到一個 epmty 單元格時記住它FirstEmptyRow
  3. 繼續循環直到再次找到數據,前一行是LastEpmtyRow 現在我們知道空白空間的開始和結束。
  4. 檢查 epmty 空間上方和空白區域下方的日期是否相同。 如果是,則將其填入空白處,否則填入x

所以你最終會得到類似的東西

Option Explicit

Public Sub FillData()
    Const START_ROW As Long = 2  'define first data row
    Const COL As String = "A"    'define the column

    Dim ws As Worksheet  'define your worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    Dim LastRow As Long  'find last used row in column A
    LastRow = ws.Cells(ws.Rows.Count, COL).End(xlUp).Row

    Dim FirstEmptyRow As Long, LastEpmtyRow As Long 'first and last empty row of a empty range

    Dim iRow As Long
    For iRow = START_ROW To LastRow
        If ws.Cells(iRow, COL).Value = vbNullString And FirstEmptyRow = 0 Then
            'found first row of an empty range
            FirstEmptyRow = iRow

        ElseIf ws.Cells(iRow, COL).Value <> vbNullString And FirstEmptyRow <> 0 Then
            'found last row of an empty range
            LastEpmtyRow = iRow - 1

            'check if same date to fill either the date or x
            If ws.Cells(FirstEmptyRow - 1, COL).Value = ws.Cells(LastEpmtyRow + 1, COL).Value Then
                'fill date
                ws.Range(ws.Cells(FirstEmptyRow, COL), ws.Cells(LastEpmtyRow, COL)).Value = ws.Cells(FirstEmptyRow - 1, COL).Value
            Else
                'fill x
                ws.Range(ws.Cells(FirstEmptyRow, COL), ws.Cells(LastEpmtyRow, COL)).Value = "x"
            End If

            'reset variables
            FirstEmptyRow = 0
            LastEpmtyRow = 0
        End If
    Next iRow
End Sub

在此處輸入圖片說明 圖 1:過程示意圖。

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM