サブセルのサブヘッダを1つのセルから別のセルに移動する必要があります。

Question

要求が簡単に聞こえます。「列を作成するコードを作成して、プロパティコードをユニット... "。私は「クール、電子メールでコードを送信します - このプロジェクトを私の雌犬にした後...」と思った。それは2日前です...

以下は、レポートと完成した出力のスニペットです。あなたの助けを前にありがとう。言うまでもなく、このプロジェクトは謙虚だった。ああ、私は最後の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