根據不同工作表中的單元格是否具有公式來在單元格中輸入的VBA代碼

Question

我希望這里有人可以幫助我。 我正在嘗試創建一個宏，該宏在一張工作表中查看一個單元格，以查看該單元格是否具有公式。 如果它有一個公式，則在不同工作表的同一單元格中輸入1，否則輸入0。這是我到目前為止的結果，但它給了我一個編譯錯誤：下一個沒有for。

Sub FormulaMap()
Dim r As Integer
Dim c As Integer

For c = 9 To 17
   For r = 11 To 18

If Sheets("Data").Cells(c & r).HasFormula = True Then
  Sheets("Map").Cells(c & r).Value = 1
  Else: Sheets("Map").Cells(c & r).Value = 0

Next r

Next c

End Sub

任何幫助表示贊賞。

Answer 1

如@Nathan_Sav所述，您需要在調用下一個r和c之前添加End If ，還需要在Cells函數中使用逗號分隔c和r 。 我還假設c是列引用， r是行引用？ 嘗試這個：

Sub FormulaMap()

   Dim r As Long
   Dim c As Long

   For c = 9 To 17
      For r = 11 To 18

         If Sheets("Data").Cells(r, c).HasFormula Then
            Sheets("Map").Cells(r, c).Value = 1
         Else
            Sheets("Map").Cells(r, c).Value = 0
         End If

      Next r
   Next c

End Sub

另請注意，VBA整數類型的范圍從-32,768到32,767。 這就是為什么建議特別在行之間使用Long（–2,147,483,648到2,147,483,647）的原因。

Answer 2

在If Then Else的結尾處，您沒有End If 。

Answer 3

一件事是Nathan_Sav所說的，但第二件事是您必須更改Cells語句，所以里面有兩個參數。 調用它的正確方法是

Cells(row, column)

所以在你的代碼中

Cells(r, c)

（如果r表示行， c列）

Answer 4

您的代碼應為

   For c = 9 To 17
   For r = 11 To 18

      If Sheets("Data").Cells(c, r).HasFormula = True Then
        Sheets("Map").Cells(c, r).Value = 1
      Else
        Sheets("Map").Cells(c, r).Value = 0
      End If


    Next r

    Next c

Answer 5

或者，您可以嘗試此方法...您可以在不同范圍內傳遞...

Option Explicit

Public Sub Test()

   Dim ws As Worksheet 'Reference the Map sheet
   Dim rData As Range 'Reference the actual range
   Set ws = Worksheets("Map")
   Set rData = Sheets("Data").Range("I11:Q18") 'Can be any range.

   'Do the call..
   Call EnumFormulas(rData, ws)

End Sub

Public Sub EnumFormulas(ByVal SourceData As Range, ByVal Destination As Worksheet)

   Dim rFoundFormulas As Range, rPtr As Range

   'Fill all data to 0's
   Destination.Range(SourceData.Address).Value = 0

   On Error Resume Next
   Set rFoundFormulas = SourceData.SpecialCells(xlCellTypeFormulas)
   On Error GoTo 0

   If Not rFoundFormulas Is Nothing Then
     For Each rPtr In rFoundFormulas
         Destination.Range(rPtr.Address).Value = 1 'Fill in 1 cell.
     Next
   End If

End Sub