VBA编程实例-升级版

Const COLUMN_NUM = 20 'クラムー数 
Const TYPE_PK = "PK" 'PKクラム 
 
 
'PKによってデータ生成 
Sub FunDataByPk(WSheet As Worksheet, Row_Start As Long, Row_End As Long, Row_Cnt As Long) 
    '変数定義 
    Dim PK_Array As Variant 'PK列存储数组 
    Dim PK_Count As Integer ' 
    Dim PK_Array_Value As Variant 
     
    'PK数 
    For i = 1 To COLUMN_NUM 
       If Trim(WSheet.Cells(3, i)) = "" Then 
           Exit For 
       End If 
       Tmp_Value = Trim(WSheet.Cells(5, i)) 'PK行 
       'PK行値=PKの場合 
       If Tmp_Value = TYPE_PK Then 
           PK_Count = PK_Count + 1 
       End If 
    Next 
     
     
    'PK配列格納を定義 
    ReDim PK_Array_Value(PK_Count - 1) '存放每个PK初始值 
    ReDim PK_Array(PK_Count - 1) '存放PK列数 
    PK_Count = 0 
     
    '存放各个PK的初始值 
    For i = LBound(PK_Array_Value) To UBound(PK_Array_Value) 
       PK_Array_Value(i) = 1 
    Next 
    'PK_Array_Value(1) = 9 
     
    'PKを取得 
    For i = 1 To COLUMN_NUM 
       If Trim(WSheet.Cells(3, i)) = "" Then 
           Exit For 
       End If 
       Tmp_Value = Trim(WSheet.Cells(5, i)) 'PK行 
       'PK行値=PKの場合 
       If Tmp_Value = TYPE_PK Then 
           PK_Array(PK_Count) = i 
           PK_Count = PK_Count + 1 
       End If 
    Next 
     
     
     
     
    Dim No As Long '第一个PK变量值 
    No = 1 
    Dim Var_LNum As Long '总列数 
    Var_LNum = Row_Start 
     
    For r = Row_Start To (Row_Cnt + Row_Start) 
        For l = 1 To COLUMN_NUM 
            Tmp_Type = Trim(WSheet.Cells(3, l)) 
            Tmp_Byte = VBA.Split(Trim(WSheet.Cells(4, l)), ",") 
            Tmp_IsPk = Trim(WSheet.Cells(5, l)) 
            If Tmp_Type = "" Then 
                Var_LNum = l 
                Exit For 
            End If 
             
            'PK的场合 
            If Tmp_IsPk = TYPE_PK Then 
                 
                If l = PK_Array(0) Then '如果当前列是顺番PK列处理 
                    If Len(No & "") > Tmp_Byte(0) Then ' 
                        No = 1 
                        Tmp_V = PK_Array_Value(1) + 1 '第二个PK值 
                        PK_Array_Value(1) = Tmp_V 
                         
                    End If 
                    WSheet.Cells(r, l) = No '第一个PK赋值 
                    No = No + 1 
                Else '非顺番PK列处理 
                     
                    Dim Tmp_Byte_i As Variant 
                    For i = 1 To UBound(PK_Array) 
                        'Tmp_Byte_i = VBA.Split(Trim(WSheet.Cells(4, PK_Array(i))), ",") 
                        Tmp_Byte_i = VBA.Split(Trim(WSheet.Cells(4, PK_Array(i))), ",") 
                     
                        If Int(Len(PK_Array_Value(i) & "")) > Int(Tmp_Byte_i(0)) Then 
                            
                           PK_Array_Value(i) = PK_Array_Value(i) - 1 
                           If (i + 1) > UBound(PK_Array) Then 
                               For h = 1 To Var_LNum 
                                   WSheet.Cells(r, h).Clear '清空最后一行 
                               Next 
                               Exit Sub 
                           End If 
                           PK_Array_Value(i + 1) = PK_Array_Value(i + 1) + 1 
                        End If 
                    Next 
                    '给当前PK列赋值 
                    For i = 1 To UBound(PK_Array) 
                        Tmp_Column_i = PK_Array(i) 
                        If Tmp_Column_i = l Then 
                            WSheet.Cells(r, l) = PK_Array_Value(i) 
                        End If 
                    Next 
                End If 
            End If 
        Next 
    Next 
     
 
 
End Sub 
 
 
'数字列を生成 
Function GetNumerics(Num As Integer) As String 
    For i = 1 To Num 
        Tmp = GetNumeric 
        If Tmp = 10 Then 
            If i = 1 Then 
                Tmp = 1 
            Else 
                Tmp = 0 
            End If 
        End If 
        GetNumerics = GetNumerics & Tmp 
    Next 
End Function 
 
'数字を生成 
Function GetNumeric() As Integer 
    Do While GetNumeric = 0 
        GetNumeric = Int(Rnd * 11) 
    Loop 
End Function 
 
 
Function Test() 
     
    Dim WSheet As Worksheet 
     
    Set WSheet = Worksheets(1) 
         
    Call FunDataByPk(WSheet, 6, 6, 50000) 
 
End Function