有没有一种方法可以根据与其他空白单元格的接近程度来编辑单元格文本?

时间:2020-07-08 20:52:55

标签: excel vba excel-formula

我有一个Excel报告,该报告是另一个财务计划的产物。我正在使用该程序的输出来使用索引/匹配和其他excel函数开发另一个综合报告。我遇到了程序给出的格式问题。 (查看所附图片)

基本上,我需要将 突出显示的 代码文本向下复制到后续代码上,直到到达空白单元格为止,然后重复执行下一个突出显示的代码。这会下降很多行,其中该块顶部的突出显示的代码需要替换以下代码,但是一旦两个空白单元格被击中,它们就会停止。没有宏,有什么方法可以实现此目的,可能使用某种形式的Offset公式?如果必须使用宏,那么这也将足够。财务程序不会让我更改格式,但出于数据透视表的目的,我需要这些唯一的标识符。谢谢!

enter image description here

1 个答案:

答案 0 :(得分:0)

如果要复制的代码之间始终有2个空行,这应该可以解决问题。如果没有,那将需要更多的工作。

Option Explicit

Sub CopyCodes()

   Dim lCurRow   As Long
   Dim lLastRow  As Long
   Dim zCopyCode As String
   
   lLastRow = ActiveSheet.Rows.Count
   lLastRow = Cells(lLastRow, 1).End(xlUp).Row() + 1
   
   zCopyCode = Cells(2, 1).Value
   Debug.Print zCopyCode
   lCurRow = 3
  
   Do
     
     If (Cells(lCurRow, 1) <> "" And _
         Cells(lCurRow, 2) <> "") Then
       Cells(lCurRow, 1) = zCopyCode
       lCurRow = lCurRow + 1
     Else
       If (Cells(lCurRow, 1) = "" And _
           Cells(lCurRow, 2) = "") Then
         lCurRow = lCurRow + 2  'Skip 2 blank rows to next code
         zCopyCode = Cells(lCurRow, 1).Value
         lCurRow = lCurRow + 1  'Move to first row to possibly copy over
       End If
       
     End If
    
   Loop Until lCurRow = lLastRow
   
End Sub  'CopyCodes

HTH