사용자 도구

사이트 도구


vba:home

EXCEL VBA

GetHangulTitle

Function GetHangulTitle(value as String)
 dim idx
 idx = instr(value, "[")
 if idx > 0 then
  GetHangulTitle = Left(value, idx - 1)
  Exit Function
 end if
 GetHangulTitle = value
End Function

GetDataType

Function GetDataType(colName As String, dataType As String, customerType As String)
    If customerType > " " Then
        GetDataType = customerType
    Else
        If Right(colName, 3) = "_YN" Then
            GetDataType = "checkbox"
        Else
            If dataType = "nchar" Then
                GetDataType = "nvarchar"
            Else
                GetDataType = dataType
            End If
        End If
    End If
End Function

CopyCellContents

Sub CopyCellContents()
    Dim objData As New DataObject
    Dim strTemp As String
    Dim str As String
 
    If Selection.Cells.Count Then
        strTemp = “”
    ElseIf Selection.Cells.Count = 1 Then
        strTemp = Selection.Value
    Else
        rMulti = Selection.Value2
        For j = LBound( rMulti, 2) To UBound(rMulti, 2)
            For i = LBound(rMulti, 1) To UBound(rMulti, 1)
                str = rMulti(i, j)
                If str > “” Then
                    If strTemp > “” Then
                        strTemp = strTemp + Chr(10) + str
                    Else
                        strTemp = str
                    End If
                End If
            Next i
        Next j
    End If
 
    objData.SetText(strTemp)
    objData.PutInClipboard
End Sub

GetRowNumber

Function GetRowNumber(tCell As Range, idx As Integer)
    Dim tableName As String
    tableName = tCell.Cells(1, idx)
 
    GetRowNumber = 1
 
    For i = 2 To 1000
        If tCell.Cells(i, idx) = tableName Then
            GetRowNumber = GetRowNumber + 1
        Else
            Exit Function
        End If
    Next
End Function

Hungarian

Function Hungarian(colNm As String)
    Dim WrdArray() As String
    Dim nm As String
    WrdArray = Split((WorksheetFunction.Proper(colNm)), "_")
    For i = LBound(WrdArray) To UBound(WrdArray)
        nm = nm & WrdArray(i)
    Next i
    nm = LCase(Left(nm, 1)) & Right(nm, Len(nm) - 1)
    Hungarian = nm
End Function

AK Array

Function getAKArray(tCell As Range, kIdx As Integer)
    Dim tableName As String
    Dim t1 As String
    Dim idx As Integer
    Dim myCols As String
    Dim tmp As String
    Dim tmpNo As Integer
    Dim i, j As Integer
    Dim ordNo As Integer
    Dim curNo As Integer
    Dim akCnt As Integer
    Dim sLog As String
    idx = 0
    ordNo = 2000
    akCnt = 0
    curNo = 0
    myCols = ""
    If (tCell.Cells.Count > 1) Then
           getAKArray = "Only allow 1 cell"
           Exit Function
    End If
    tableName = tCell.Cells(1, 1)
    idx = GetRowNumber(tCell, kIdx - 1)
    For i = 1 To idx
        If tCell.Cells(i, 1) > "" Then
            akCnt = akCnt + 1
            curNo = tCell.Cells(i, 1)
            If curNo > 0 And  ordNo > curNo Then
                ordNo = curNo
                myCols = tCell.Cells(i, kIdx)
            End If
        End If
    Next
    For j = 2 To akCnt
        curNo = 2000
        For i = 1 To idx
            If tCell.Cells(i, kIdx) > "" Then
                If tCell.Cells(i, 1) >= ordNo And tCell.Cells(i, 1) < curNo Then
                    If InStr(myCols, tCell.Cells(i, kIdx)) = 0 Then
                        tmp = tCell.Cells(i, kIdx)
                        curNo = tCell.Cells(i, 1)
                    End If
                End If
            End If
        Next
        ordNo = curNo
        myCols = myCols + ", " + tmp
    Next
    If myCols > "" Then
        'getAKArray = "alter table dbo." + tableName + " add constraint AK_" + tableName + " UNIQUE NONCLUSTERED (" + myCols + ");"
        getAKArray = myCols
    Else
        getAKArray = ""
    End If
    'getAKArray = myCols ' + CStr(curNo) + ":" + CStr(ordNo)
End Function

사용하는 DLL

DataObject는 MSForms를 필요로 한다.

MSForms가 목록에없고 참조 목록에서 찾을 수 없으면 참조를 추가 한 다음“찾아보기…”버튼을 눌러 파일을 찾습니다 당신 자신. MSForms는“FM20.dll”이라는 파일에 있습니다 (최소한 버전 2.0의 경우; 다른 버전은 그에 따라 번호가 매겨 질 것입니다) Windows \ System32 폴더 그런 식으로 추가 할 수 있어야합니다 ( UserForm 추가). 파일을 찾을 수 없으면 어떻게 든 얻을 수 있습니다 지워지고 Excel을 다시 설치해야 할 수도 있습니다.

Module생성하고

vba/home.txt · 마지막으로 수정됨: 2025/04/15 10:05 저자 127.0.0.1