Information on extracting data with matrix replacement on a separate sheet

I would like to create a macro VBA that extracts the finished sheet (see photo 2) from the original data sheet (see photo 1).

The procedure can be translated into Japanese (see photo 3), but
I don't know what code to write in the macro VBA.

I would appreciate it if you could let me know if you are familiar with it and what kind of code I should write.
Also, if you don't mind, I would appreciate it if you could tell me how you became familiar with ExcelVBA and how to study it.
(Now I can only do each textbook task (e.g., swap rows and columns, extract data that swap rows and columns, etc.) and I can't afford it at all in practice.)

追Additional
I am asking a question with a similar title on teratail, Qiita, but the content is different.
The above two sites are asking about a simplified version of the problem in this post.
(How to arrange mixed alphabetic and numeric data in ascending order by digit or
After converting the table vertically and horizontally, I didn't know how to sort the two sets of data in ascending order of one data, so I asked you a question.)

vba excel

2022-09-30 21:55

1 Answers

I will use this article as a reference to create the process.

How do I check if a sheet with the specified name exists
How to copy and rename the sheet
The 88th.Sort
How to hold vertical data horizontally
If the cell range of interest for the operation is indefinite
How to retrieve the last row and last column (End, CurrentRegion, SpecialCells, UsedRange)

The building name sorting rule in (1) seems to be the same as the usual concept of string sorting, so you can do it with the sorting function of EXCEL VBA without creating any special functions.

It seems that it is faster to capture the data as an array and write the results on the sheet, but I myself do not have much knowledge and experience with EXCEL VBA, so I made it to use the function of EXCEL.
I want to convert two VBA vertical columns into three horizontal columns (can be changed to more than one)

'Main Processing
SubTransformTable()
    Dimi As Long, c As Range, wS As Worksheet
    Dim x As Long, h1 As String, h2 As String
    
    Application.ScreenUpdating=False'Turn off mid-work display
    
    ' Delete "horizontal sheet" if present
    If IsSheetExists ("horizontal sheet") Then
        Application.DisplayAlerts=False
        Sheets ("horizontal sheet").Delete
        Application.DisplayAlerts=True
    End If
    
    ' Copy and sort "vertical sheet" to work sheet
    Call Sheets("vertical sheet").Copy(After:=Sheets("vertical sheet")
    ActiveSheet.Name="WorkTemp"
    SetS = ActiveSheet
    h1 = wS.Cells (1, "B") 'Remember column name base
    h2=wS.Cells(1, "C")' column name base stored
    WithS.Sort
        With.SortFields
            .Clear
            .Add Key: =wS.Range("A1"), Order: =xlAscending'In ascending order of building names
            .Add Key: =wS.Range("C1"), Order: =xlDescending'Decrease congestion percentage
        End With
        .SetRange wS.Range("A1").CurrentRegion
        .Header=xlYes
        .Apply
    End With

    ' Create a "horizontal sheet" and rearrange the contents of the work sheet and copy it.
    Call Sheets.Add(After:=Sheets("vertical"))
    ActiveSheet.Name="horizontal"
    SetS = ActiveSheet
    wS.Cells.ClearContents
    With Worksheets ("WorkTemp")
        .Range("A:A").AdvancedFilter Action:=xlFilterCopy, copytorange:=wS.Range("A1"), Unique:=True
        Fori=2 To.Cells (Rows.Count, "A").End(xlUp).Row
            Setc=wS.Range("A:A").Find(what:=.Cells(i, "A"), LookIn:=xlValues, lookat:=xlWhole)
            wS.Cells(c.Row, Columns.Count).End(xlToLeft).Offset(,1)=.Cells(i, "B")' Room (set by extending to the right)
            wS.Cells(c.Row, Columns.Count).End(xlToLeft).Offset(,1) =.Cells(i, "C")' Congestion Ratio (same as above)
        Next i
    End With
    
    ' Set column name + number as much as data exists
    x=(wS.Range("A1").CurrentRegion.Columns.Count-1)/2
    Fori= 1 To x
        wS.Cells(1, Columns.Count).End(xlToLeft).Offset(,1)=h1+str(i)'Room + column number
        wS.Cells(1, Columns.Count).End(xlToLeft).Offset(,1) = h2+str(i)' Congestion Ratio + Column Number
    Next i

    ' Delete Worksheet
    Application.DisplayAlerts=False
    Sheets("WorkTemp").Delete
    Application.DisplayAlerts=True
    
    Application.ScreenUpdating=True' Resume Display
    wS.Activate

End Sub

' Check sheet exists by name
Function IsSheetExists (strSheetName As String)
    DimobjWorksheet As Worksheet
    On Error GoTo NotExists
    
    SetobjWorksheet=ThisWorkbook.Sheets(strSheetName)
    IsSheetExists=True
    Exit Function
NotExists:
    IsSheetExists= False
End Function

2022-09-30 21:55

If you have any answers or tips

Popular Tags

python x 4647

android x 1593

java x 1494

javascript x 1427

c x 927

c++ x 878

ruby-on-rails x 696

php x 692

python3 x 685

html x 656