GaramX

사용자 도구

사이트 도구

현재 위치: home » vba
추적: • gcloud • typescript
vba:home

차이

문서의 선택한 두 판 사이의 차이를 보여줍니다.

차이 보기로 링크

양쪽 이전 판이전 판
다음 판		이전 판
vba:home [2024/01/05 15:52] – [GetHangulTitle] taekguvba:home [2025/04/15 10:05] (현재) – 바깥 편집 127.0.0.1
줄 1: 줄 1:
 +====== EXCEL VBA ======
 +===== GetHangulTitle =====
 +
 +<code vb>
 +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
 +</code>
 +===== GetDataType =====
 +<code vb>
 +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
 +</code>
 +===== CopyCellContents =====
 +<code vb>
 +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
 +</code>
 +===== GetRowNumber =====
 +<code vb>
 +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
 +</code>
 +===== Hungarian =====
 +<code vb>
 +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
 +</code>
 +
 +===== AK Array =====
 +<code vb>
 +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
 +</code>
 +===== 사용하는 DLL =====
 +''DataObject는 MSForms를 필요로 한다.''
 +
 +MSForms가 목록에없고 참조 목록에서 찾을 수 없으면
 +참조를 추가 한 다음“찾아보기…”버튼을 눌러 파일을 찾습니다
 +당신 자신. MSForms는“FM20.dll”이라는 파일에 있습니다 (최소한 버전 2.0의 경우;
 +다른 버전은 그에 따라 번호가 매겨 질 것입니다)
 +Windows \ System32 폴더 그런 식으로 추가 할 수 있어야합니다 (
 +UserForm 추가). 파일을 찾을 수 없으면 어떻게 든 얻을 수 있습니다
 +지워지고 Excel을 다시 설치해야 할 수도 있습니다.
 +===== Module생성하고 =====
  

문서 도구