Question

我目前正在使用Excel 2003并且有一个问题但是如果不显示图片就无法制定。不幸的是，在我有10个声誉（？）之前，我不能这样做。我会尽力描述它。

我有一个电子表格，其中包含A列粗体标题，然后位于其下方（也从A列开始）是属于该标题的记录。我尝试在下面重新创建它，但请注意：在真实的电子表格中，任何行之间都没有空行。记录由3列组成（在这种情况下，第3列是由真实电子表格包含机密信息组成的）。

**Fire**
05/07/2014      RP140028540   asdsfsfafk  
05/07/2014      RP140028541   asdsfsfafk    
05/07/2014      RP140028545   asdsfsfafk  
05/07/2014      RP140028548   asdsfsfafk    

**EMS**
05/07/2014      RP140028345   asdsfsfafk  
05/07/2014      RP140028549   asdsfsfafk    
05/07/2014      RP140028678   asdsfsfafk  

**Haz-Mat**
05/07/2014      RP140028111   asdsfsfafk  
05/07/2014      RP140028222   asdsfsfafk    
05/07/2014      RP140028333   asdsfsfafk  
05/07/2014      RP140028888   asdsfsfafk    
05/07/2014      RP140028284   asdsfsfafk

我想创建一个代码，它将获取第一列的值（当加粗，然后是一个标题），然后在D列中创建一个新创建的变量的值。这些值将一直持续到达到一个新的标题然后该过程重新开始。所以它看起来像这样：

**Fire** 
05/07/2014      RP140028540   asdsfsfafk  Fire  
05/07/2014      RP140028541   asdsfsfafk  Fire    
05/07/2014      RP140028545   asdsfsfafk  Fire  
05/07/2014      RP140028548   asdsfsfafk  Fire  

**EMS**
05/07/2014      RP140028345   asdsfsfafk  EMS  
05/07/2014      RP140028549   asdsfsfafk  EMS    
05/07/2014      RP140028678   asdsfsfafk  EMS  

**Haz-Mat**
05/07/2014      RP140028111   asdsfsfafk  Haz-Mat  
05/07/2014      RP140028222   asdsfsfafk  Haz-Mat    
05/07/2014      RP140028333   asdsfsfafk  Haz-Mat  
05/07/2014      RP140028888   asdsfsfafk  Haz-Mat    
05/07/2014      RP140028284   asdsfsfafk  Haz-Mat

我知道区分标题和记录的方法是通过逻辑说明第二列是否为空，然后第四列的值等于第一列。但我不确定如何使该逻辑继续存在于该标题下的所有记录。

我想这样做的原因是双重的。一，我将创建一个仅包含选择组的报告，这对我来说是最简单的方法（因为编写保存或删除某些行的代码是关于我唯一的VB体验）。但更重要的是，最终这些信息将用于GIS，并由这些值进行分层。因此，我将需要此列以供将来使用数据集。

        Dim rowToTest As Long
For rowToTest = Cells(Rows.Count, 1).End(xlToRight).Row To 1 Step 1
With Cells(rowToTest, 1)
    If .Value <> "" And Cells(rowToTest, 3).Value = "" Then Cells(rowToTest, 5).Value = Cells(rowToTest, 1)
End With
Next rowToTest

我已经在线查看，但由于我无法解释我想要做什么，我无法找到能够创建所需结果的代码。上面列出的是我希望至少让我将组头复制到空单元格的代码。但是它不成功。此外，我仍然坚持如何将值拉低，直到达到新值。任何帮助将非常感激。谢谢。

Answer 1

这是一个可能的基于公式的解决方案：

enter image description here

填写公式后，您可以复制/粘贴值。

在VBA中：

Sub Tester()

Dim rowToTest As Long, header As String, sht As Worksheet
Dim lastRow As Long, rw As Range

Set sht = ActiveSheet
lastRow = sht.Cells(Rows.Count, 1).End(xlUp).Row
header = ""

For rowToTest = 1 To lastRow

    Set rw = sht.Rows(rowToTest)

    If Len(rw.Cells(1).Value) > 0 And Len(rw.Cells(2).Value) = 0 Then
        header = rw.Cells(1).Value
    ElseIf Application.CountA(rw.Cells(1).Resize(1, 3)) = 3 Then
        rw.Cells(4).Value = header
    Else
        'do nothing
    End If

Next rowToTest

End Sub

如何在找到新值之前继续新创建的变量的值？

1 个答案: