GaramX

사용자 도구

사이트 도구

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

차이

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

차이 보기로 링크

양쪽 이전 판이전 판
다음 판		이전 판
vba:home [2020/06/18 02:35] – [CopyCellContents] taekguvba:home [2025/04/15 10:05] (현재) – 바깥 편집 127.0.0.1
줄 1: 줄 1:
-====== EXCEL ======+====== EXCEL VBA ======
 ===== GetHangulTitle ===== ===== GetHangulTitle =====
  
-<code vba>+<code vb>
 Function GetHangulTitle(value as String) Function GetHangulTitle(value as String)
  dim idx  dim idx
줄 14: 줄 14:
 </code> </code>
 ===== GetDataType ===== ===== GetDataType =====
-<code vba>+<code vb>
 Function GetDataType(colName As String, dataType As String, customerType As String) Function GetDataType(colName As String, dataType As String, customerType As String)
     If customerType > " " Then     If customerType > " " Then
줄 32: 줄 32:
 </code> </code>
 ===== CopyCellContents ===== ===== CopyCellContents =====
-<code vba>+<code vb>
 Sub CopyCellContents() Sub CopyCellContents()
     Dim objData As New DataObject     Dim objData As New DataObject
줄 38: 줄 38:
     Dim str As String     Dim str As String
    
-    Set rMulti = Selection.Cells() +    If Selection.Cells.Count Then 
-    For Each rCell In rMulti.Cells +        strTemp = “” 
-        str = rCell.Value +    ElseIf Selection.Cells.Count = 1 Then 
-        If str > "" Then +        strTemp = Selection.Value 
-            If strTemp > "" Then +    Else 
-                strTemp = strTemp + Chr(10) + str +        rMulti = Selection.Value2 
-            Else +        For j = LBound( rMulti, 2) To UBound(rMulti, 2) 
-                strTemp = str +            For i = LBound(rMulti, 1) To UBound(rMulti, 1) 
-            End If +                str = rMulti(i, j) 
-        End If +                If str > “” Then 
-    Next rCell +                    If strTemp > “” Then 
-    objData.SetText (strTemp)+                        strTemp = strTemp + Chr(10) + str 
 +                    Else 
 +                        strTemp = str 
 +                    End If 
 +                End If 
 +            Next i 
 +        Next j 
 +    End If 
 +     
 +    objData.SetText(strTemp)
     objData.PutInClipboard     objData.PutInClipboard
 End Sub 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> </code>
 ===== 사용하는 DLL ===== ===== 사용하는 DLL =====
-DataObject는 MSForms를 필요로 한다.+''DataObject는 MSForms를 필요로 한다.''
  
 MSForms가 목록에없고 참조 목록에서 찾을 수 없으면 MSForms가 목록에없고 참조 목록에서 찾을 수 없으면
줄 63: 줄 162:
 UserForm 추가). 파일을 찾을 수 없으면 어떻게 든 얻을 수 있습니다 UserForm 추가). 파일을 찾을 수 없으면 어떻게 든 얻을 수 있습니다
 지워지고 Excel을 다시 설치해야 할 수도 있습니다. 지워지고 Excel을 다시 설치해야 할 수도 있습니다.
 +===== Module생성하고 =====
 +
vba/home.1592447738.txt.gz · 마지막으로 수정됨: 2025/04/15 10:05 (바깥 편집)

문서 도구