VBAプログラミング例
18823 ワード
- 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)
- '� � �x
- Dim PK_Array As Variant
- 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 �{を �x
- ReDim PK_Array_Value(PK_Count - 1) '
- ReDim PK_Array(PK_Count - 1)
- 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 Column_PK_No As Integer
- Column_PK_No = 0 '� �
- Dim No As Long
- Dim No_Num As Long
- Dim Var_LNum As Long
- No_Num = 6
- No = 1
- 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
-
- If Tmp_IsPk = TYPE_PK Then
-
- If l = PK_Array(0) Then
- If Len(No & "") > Tmp_Byte(0) Then
- No = 1
- 'No_Num = No_Num + 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
- 'If Len(No_Num & "") > Tmp_Byte(0) Then
- 'No_Num = No_Num - 1
- 'End If
- 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
-
- 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
-
- 'MsgBox (Int(UBound(PK_Array)) + 1)
-
- 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