VBA Excel에서 유용한 열을 추출하여 정렬합니다.

2475 단어
stData  ,rngConfig   
Public Function Run(ByRef stData As Worksheet, ByRef rngConfig As Range) As Worksheet
'On Error GoTo Proc_Err
    Dim r_Config As Integer, str_ColumnName As String
    Dim stNew As Worksheet
    'stData.Copy After:=stData
    stData.Activate
    stData.Parent.Sheets.Add After:=stData
    Set stNew = ActiveSheet
    stNew.Name = rngConfig.Worksheet.Name
   
    Dim col As Range, errMsg As String, c_new As Integer
    c_new = 0
    For r_Config = 2 To rngConfig.rows.Count
        str_ColumnName = rngConfig.Cells(r_Config, 1)
        If str_ColumnName <> "" Then
        'MsgBox str_ColumnName
        
            Call myFun.getColumnByName(stData, 1, str_ColumnName, col, errMsg, False)
            col.Copy
            c_new = c_new + 1
            stNew.Activate
            stNew.Cells(1, c_new).Select
            stNew.Paste
        End If
    Next r_Config   
    Exit Function
End Function
Rem  , 
Public Function getRow(sheet As Worksheet, tag As String, Optional beginRow As Long = 1) As Long
    Dim r As Long
    With sheet.UsedRange
        For r = beginRow To .rows.Count
            If .Cells(r, 1).Value = tag Then
                getRow = r
                Exit Function
            End If
        Next
    End With
    getRow = 0
End Function

Rem  , 
Public Function getColumn(opSheet As Worksheet, headerRow As Long, tag As String) As Integer
    Dim c As Integer
    Dim msg As String
    With opSheet
        For c = 1 To .UsedRange.Columns.Count
            If .Cells(headerRow, c) = tag Then
                getColumn = c
                Exit Function
            End If
        Next
    End With
    getColumn = 0
End Function

Rem  , 
Public Function getColumnByName(opSheet As Worksheet, headerRow As Long, tag As String, returnColumn As Range, Optional ByRef errMessage As String, Optional showErrMsg As Boolean = False) As Boolean
    getColumnByName = False
    
    Dim c As Integer
    c = getColumn(opSheet, headerRow, tag)
    If (c = 0) Then
'        showErrMsg = True
        errMessage = " [" & opSheet.Name & "] [" & tag & "], !"
        If (showErrMsg) Then
            MsgBox errMessage, vbInformation, " "
        End If
        Exit Function
    Else
        Set returnColumn = opSheet.Columns(c)
    End If
    
    getColumnByName = True
End Function

좋은 웹페이지 즐겨찾기