Question

我有以下代码从一个范围（此处为D3到D30）复制数字（没有颜色）并将其粘贴到从第1行开始的F列中并进行一些百分位计算。

问题是，我注意到在第一行的F列中出现了杂散数字“5”，即使我的范围D3-D30中没有这样的数字。

   Sub TPNoRedpass50tablet()

     Dim cel As Range
     Dim Rng As Range
     Dim arr As Variant
     Dim i As Long
     Application.ScreenUpdating = False
       For Each cel In Sheets("TP").Range("TP!$D$3:$D$30")
         If cel.Font.Color = 0 Then
         If Rng Is Nothing Then
         Set Rng = cel
     Else
         Set Rng = Union(cel, Rng)
         End If
         End If
      Next cel
      ReDim arr(Rng.count - 1)
        If Not Rng Is Nothing Then
            For Each cel In Rng
               arr(i) = cel
               i = i + 1
      Next cel
     Sheets("TP").Range("F1").Resize(UBound(arr) + 1).Value = Application.Transpose(arr)
     Set Rng = Sheets("TP").Range("F1:I" & Sheets("TP").Cells(Rows.count, "F").End(xlUp).Row)
     Sheets("WBR").Range("AH101").Formula = "=PERCENTILE.INC(" & Rng.Address(, , , True) & ",50%)*24"
     Sheets("WBR").Range("AH101").Value = Sheets("WBR").Range("AH101").Value


      End If
      Application.ScreenUpdating = True
 End Sub

Answer 1

试试这个：

   Sub TPNoRedpass50tablet()

     Dim cel As Range
     Dim Rng As Range
     Dim arr As Variant
     Dim i As Long

     Application.ScreenUpdating = False
       For Each cel In Sheets("TP").Range("TP!$D$3:$D$30")
         If Rng Is Nothing Then
         Set Rng = cel       
         If cel.Font.Color = 0 Then
     Else
         Set Rng = Union(cel, Rng)
         End If
         End If
      Next cel
      ReDim arr(Rng.count - 1)
        If Not Rng Is Nothing Then
            For Each cel In Rng
               arr(i) = cel
               i = i + 1
      Next cel
     Sheets("TP").Range("F1").Resize(UBound(arr) + 1).Value = Application.Transpose(arr)
     Set Rng = Sheets("TP").Range("F1:I" & Sheets("TP").Cells(Rows.count, "F").End(xlUp).Row)
     Sheets("WBR").Range("AH101").Formula = "=PERCENTILE.INC(" & Rng.Address(, , , True) & ",50%)*24"
     Sheets("WBR").Range("AH101").Value = Sheets("WBR").Range("AH101").Value


      End If
      Application.ScreenUpdating = True
 End Sub

问题似乎是每个循环的第一个问题。你有一个联盟，只有在第一次没有设置Rng时才会执行。

执行vba代码后出现垃圾编号

1 个答案: