使用VBA Excel我試圖計算條目之間的列中空白單元格的數量

Question

我想確定非空白單元格之間的列中空白單元格的數量。我有一個excel電子表格，顯示去年股票的每日收盤價格。 excel中的每一行都按時間順序列出每日收盤價格。電子表格列出了我購買股票的一天以及我在相關行中出售股票的那一天。一個特定的列用於記錄日期。電子表格的摘錄包含在下面。

Stock  Date  ClosingPrice Entered/Exited DaysHeld? 
-------- ------------- --------------- ----------------- ------------ 
    Apple 01/02/2017   116.25 Bought       
    Apple 01/03/2017   119.75         
    Apple 01/04/2017   117.50         
    Apple 01/05/2017   118.75 Sold       

我想要的「輸入」行之間的空白單元格的數量確定爲「已退出」行下的列標題進入/使用已退出在VBA Excel中的一個循環，我換很多股票和複製和粘貼每次都有一個Excel配方變得耗時。

編譯下面的代碼來計算空白單元格的數量，但它總是返回值1.在下面的代碼中，單元格AI56是我購買股票的日子，'買入'列標題'輸入/退出「

Sub SandpitCountBlankCells() 

' SandpitCoutBlankCells Macro 
' Macro calculates the number of blank spaces 
' 

'Step 1: Declare variables 
Dim CountBlankCells As Long 
CountBlankCells = 0 

'Select Cell AI56 
Range("AI56").Select 
ActiveCell.Offset(-1, -1).Range("A1").Select 

'Check wheher the cell in the previous row is blank 
If ActiveCell.Value = Blank Then 
CountBlankCells = CountBlanksCells + 1 

'While loop to check whether cells in the previous rows are blank 
While ActiveCell.Value = Blank 
ActiveCell.Offset(-1, 0).Range("A1").Select 
ActiveCell.Select 
CountBlankCells = CountBlanksCells + 1 

'Place the value of the number of blank cells in cell AL56 
Range("AJ56").Value = CountBlankCells 

'Exit the loop 
Wend 

Range("AJ56").Value = CountBlankCells 


End If 


End Sub 

Answer 1

當你把：

Option Explicit 

你VBA模塊的頂部，你會看到有一個錯誤類型和CountBlanksCells尚未聲明：

CountBlankCells = CountBlanksCells + 1 

應該是：

CountBlankCells = CountBlankCells + 1 

另外，compliler不喜歡 '空白'，而不是使用：

While ActiveCell.Value = Empty 

Answer 2

你最好不要使用Select和ActiveCell只要有可能（見VBA最好避免文件中的實踐）。該方法將循環遍歷AI列中的所有內容，併爲每個實例提供空白，而不僅僅是AI56中的一個。

Sub CountDays() 
Dim ws As Worksheet 
Dim x As Long, y As Long 
Dim entExtCol As Long, daysHeldCol As Long, startRow As Long, endRow As Long 

On Error GoTo ErrHandler 

Set ws = ActiveSheet 
entExtCol = 35 'Col AI 
daysHeldCol = 36 'Col AJ 
startRow = 2 'start of data 
endRow = ws.Cells(ws.Rows.Count, entExtCol).End(xlUp).Row 'end of data 

Application.ScreenUpdating = False 
Application.Calculation = xlCalculationManual 

For x = startRow To endRow 
    If ws.Cells(x, entExtCol) = "Bought" Then 
     ct = 0 
     For y = x To endRow 
      If ws.Cells(y, entExtCol) = "Sold" Then 
       ws.Cells(x, daysHeldCol) = ct 
       Exit For 
      Else 
       ct = ct + 1 
      End If 
     Next y 
    End If 
Next x 

Application.ScreenUpdating = True 
Application.Calculation = xlCalculationAutomatic 

ErrHandler: 

Application.ScreenUpdating = True 
Application.Calculation = xlCalculationAutomatic 

End Sub