我需要从一个单元格移动子集的子标题，将其值与其各自的行相邻

Question

请求听起来很简单：“我需要你创建一些代码来创建一个列，将属性代码移动到与单元相同的行......”。我想“很酷，我会通过电子邮件发送代码 - 在我把这个项目变成我的婊子之后......”。那是两天前......

以下是报告的片段和完成的输出。在此先感谢您的帮助。不用说，这个项目令人羞愧。哦是的，我注意到最后一个MultiFamily单元“112”s / b“112”。我会纠正的。

之前/之后的报告

实际报告超过5K记录，但格式相同。以下是实际数据：

Fig 1.
           (A)                                  |   (B)
(01)  Property                                  | Tenant  
(02)  Unit                                      | Code
(03)  118 - MultiFamily Facility 1              |
(04)         0118                               | t0103001
(05)         0121                               | t0077028
(06)         0124                               | t0099589
(07)         Total 118 - MultiFamily Facility 1 |
(08)  119 - MultiFamily Facility 2              |
(09)         001                                | t0103128
(10)         002                                | t0101985
(11)         003                                | t0102938
(12)         Total 119 - MultiFamily Facility 2 |
(13)  121 - MultiFamily Facility 3              |
(14)         001                                | t0099507
(15)         002                                | t0101773
(16)         003                                | t0103123
(17)         004                                | t0099821
(18)         005                                | t0077281
(19)         Total 121- MultiFamily Facility 3  |  


fig.2

      (A)      |    (B)    |  (C)
(01)  Property |    Unit   |  Tenant Code
(02)  118      |    0118   |   t0103001
(03)  118      |    0121   |   t0077028
(04)  118      |    0124   |   t0099589
(05)           |     Total 118 - MultiFamily Facility 1 
(06)  119      |    001    |   t0103128
(07)  119      |    002    |   t0101985
(08)  119      |    003    |   t0102938
(09)           |     Total 119 - MultiFamily Facility 2 
(10)  121      |    001    |   t0099507
(11)  121      |    002    |   t0101773
(12)  121      |    003    |   t0103123
(13)  121      |    004    |   t0099821
(14)  121      |    005    |   t0077281
(15)           |     Total 121 - MultiFamily Facility 3

Answer 1

有更好的方法来编写以下代码，但这将根据您提供的信息执行您所需的操作。它不会进行格式化。您可以自己录制单独的宏，也可以手动格式化。

如果您多次执行此操作，可以使用自动执行最后一行，标题行和列编号的方法。我基本上对它们进行了硬编码，但你也可以调整它以适应所选范围，但我并不觉得无聊，也不是我的技能提升。

Option Explicit

Sub MakeReport()
Dim HeaderRow, FirstRow, LastRow, sPropertyCol, sTenantCol, dPropertyCol, dUnitCol, dTenantCol, CounterX, CounterY As Long
Dim wsSource, wsDest As Worksheet
Dim PropertyNumber As String

'This chunk of code defines where the source information is and
'were destination information goes in terms of column and row numbers

HeaderRow = 2
FirstRow = 3
LastRow = 19

sPropertyCol = 1
sTenantCol = 2

dPropertyCol = 1
dUnitCol = 2
dTenantCol = 3

'This is the first row of Data on the destination sheet
CounterY = 2

'rename the sheets as required to suit your sheet names
Set wsSource = Worksheets("Sheet1")
Set wsDest = Worksheets("Sheet2")

'Taking care of the rearranged header inofrmation
wsDest.Range("A1") = wsSource.Range("A1")
wsDest.Range("B1") = wsSource.Range("A2")
wsDest.Range("C1") = wsSource.Range("B1") & " " & wsSource.Range("B2")

'Loop through data check if its a total row then
'Check if its a property row
'otherwise treat it as a unit row
'Does not eliminate blank lines, just repeats them

For CounterX = FirstRow To LastRow
    If InStr(wsSource.Cells(CounterX, sPropertyCol).Value, "Total") = 0 Then
        If InStr(wsSource.Cells(CounterX, sPropertyCol).Value, "-") <> 0 Then
           PropertyNumber = Left(wsSource.Cells(CounterX, sPropertyCol).Value, InStr(wsSource.Cells(CounterX, sPropertyCol).Value, "-") - 2)
        Else
           wsDest.Cells(CounterY, dPropertyCol).Value = PropertyNumber
           wsDest.Cells(CounterY, dUnitCol).Value = wsSource.Cells(CounterX, sPropertyCol).Value
           wsDest.Cells(CounterY, dTenantCol).Value = wsSource.Cells(CounterX, sTenantCol).Value
           'increase the row you are going to write to next
           CounterY = CounterY + 1
        End If
    Else
        wsDest.Cells(CounterY, dUnitCol).Value = wsSource.Cells(CounterX, sPropertyCol).Value
        'increase the row you are going to write to next
        CounterY = CounterY + 1
    End If
Next CounterX

End Sub

Answer 2

相同的答案，一些不同的技术......

Option Explicit

Sub test()
Dim srcSht As Worksheet, tarSht As Worksheet
Dim srcRng As Range, tarRange As Range
Dim myCell As Range, myStr As String, ZeroStr As String
Dim myFacility As Long, nZeros As Long
Dim srcFirstRow As Long, srcLastRow As Long, tarLastRow As Long
Dim iLoop As Long, jLoop As Long, iCount As Long


' initialize
    Set srcSht = Worksheets("Sheet1") '<~~ pick the sheet names you need
    Set tarSht = Worksheets("Sheet2")

    srcFirstRow = 3
    srcLastRow = srcSht.Range("A" & srcSht.Rows.Count).End(xlUp).Row
    Set srcRng = srcSht.Range(srcSht.Cells(1, 1), srcSht.Cells(srcLastRow, 3))

    myFacility = -1
    iCount = 1
' prepare the target sheet
    tarLastRow = tarSht.Range("B" & tarSht.Rows.Count).End(xlUp).Row
    tarSht.Range(tarSht.Cells(1, 1), tarSht.Cells(tarLastRow, 3)).Delete (xlUp)
    tarSht.Range("A1").Value = "Property"
    tarSht.Range("B1").Value = "Unit"
    tarSht.Range("C1").Value = "Tenant Code"
' you may want to add some formatting of the target sheet at this point


    For iLoop = srcFirstRow To srcLastRow
        myStr = ""
        If InStr(srcRng.Range("A" & iLoop).Value, "-") Then
' find the facility heading, the number goes in myFacility
            myStr = Trim(Split(srcRng.Range("A" & iLoop), "-")(0))
            myFacility = -1
            On Error Resume Next
                If Len(myStr) > 0 Then myFacility = CLng(myStr)
            On Error GoTo 0
            If myFacility = -1 Then
                iCount = iCount + 1
                tarSht.Cells(iCount, 2).Value = srcRng.Cells(iLoop, 1).Value
            End If
        Else
' put values in target sheet
            iCount = iCount + 1
            tarSht.Cells(iCount, 1).Value = myFacility
            tarSht.Cells(iCount, 2).Value = srcRng.Range("A" & iLoop).Value
            nZeros = Len(Trim(srcRng.Range("A" & iLoop).Value))
            ZeroStr = ""
            For jLoop = 1 To nZeros
                ZeroStr = ZeroStr & "0"
            Next jLoop
            tarSht.Range("B" & iCount).NumberFormat = ZeroStr '<~~ set this as needed
            tarSht.Cells(iCount, 3).Value = srcRng.Range("B" & iLoop).Value
        End If

    Next iLoop
End Sub