Vba 我需要移动一个子集'；一个单元格中的s子标题将其值放置在其相应行附近

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

下面是报告的一个片段和完成的输出。提前感谢你的帮助。不用说，这个项目令人谦卑。哦，是的，我注意到最后一个多户型单元“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

---

有更好的方法编写以下代码，但这将根据您提供的信息满足您的要求。它不会进行格式化。您可以自己录制一个单独的宏，也可以手动格式化

如果要多次执行此操作，则有几种方法可以自动执行最后一行、标题行和列编号。我基本上是硬编码的，但你也可以调整它来处理选定的范围，但我没有那么无聊，我的技能也没有那么先进

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

选项显式
子报表（）
昏暗的头部，第一排，最后一排，sPropertyCol，sTenantCol，Dropertycol，dUnitCol，dTenantCol，CounterX，CounterY等长
将wsSource、wsDest设置为工作表
Dim PropertyNumber作为字符串
'这段代码定义了源信息的位置和
'目的地信息以列和行号表示
HeaderRow=2
第一行=3
最后一行=19
sPropertyCol=1
狭窄素=2
dPropertyCol=1
dUnitCol=2
DTENATCOL=3
'这是目标工作表上的第一行数据
反Y=2
'根据需要重命名图纸以适合您的图纸名称
设置wsSource=工作表（“表1”）
设置wsDest=工作表（“表2”）
'处理重新排列的标题信息'
wsDest.Range（“A1”）=wsSource.Range（“A1”）
wsDest.Range（“B1”）=wsSource.Range（“A2”）
wsDest.Range（“C1”）=wsSource.Range（“B1”）和“&wsSource.Range（“B2”）
'循环检查数据是否为总计行，然后
'检查它是否是属性行
'否则将其视为一个单位行
'不会消除空行，只是重复它们
对于计数器X=第一行到最后一行
如果InStr（wsSource.Cells（CounterX，sPropertyCol.Value，“Total”）=0，则
如果InStr（wsSource.Cells（CounterX，sPropertyCol）.Value“-”）为0，则
PropertyNumber=Left（wsSource.Cells（CounterX，sPropertyCol）.Value，InStr（wsSource.Cells（CounterX，sPropertyCol）.Value），“-”-2）
其他的
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
'增加要写入下一行的行数
计数器Y=计数器Y+1
如果结束
其他的
wsDest.Cells（CounterY，dUnitCol）.Value=wsSource.Cells（CounterX，sPropertyCol）.Value
'增加要写入下一行的行数
计数器Y=计数器Y+1
如果结束
下一个计数器
端接头

相同的答案，一些不同的技巧

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

选项显式
子测试（）
将srcSht作为工作表，tarSht作为工作表
变光srcRng作为范围，tarRange作为范围
Dim myCell作为范围，myStr作为字符串，ZeroStr作为字符串
Dim myFacility尽可能长，nZeros尽可能长
将srcLastRow变长，srcLastRow变长，tarLastRow变长
Dim iLoop尽可能长，jLoop尽可能长，iCount尽可能长
“初始化
Set srcSht=Worksheets（“Sheet1”）“我发布了原始输出的图像和重新格式化的报告。请同时发布您的代码和不适合您的内容。@OldShugh他们从来没有代码XD第二次我看到这一点时，问题中的s/b指的是什么？@转发-我猜这是诵读困难症：112应该是121。但是，我不知道s/b是什么意思。（应该是？）有趣的调整。问题：1）由于总计行和第一个属性行中都有“-”号，因此下一个错误恢复是否用于捕获总计行？2） 这个方法是保持前导零还是将字符串转换成数字..或者这就是nZeros的作用？1）是的。2） 它转换为数字，因此零丢失。所以我计算零（nZeros）并格式化单元格以显示它们。ZeroStr最后是“0000”或“000”。我认为有一种更有效的方法可以做到这一点，但还没有找到它。Jeeped有一种很好的方法可以做到这一点，如果你使用excel公式将它保持为字符串。没有理由在这里不起作用。只需将一个仅为“000000000”的巨大字符串连接到左侧，然后取一个右侧（大字符串，要显示的字符数）