ConstCOLUMN_NUM=20'クラム?数ConstTYPE_PK="PK"'PKクラム'PKによってデ?タ生成SubFunDataByPk(WSheetAsWorksheet,Row_StartAsLong,Row_EndAsLong,Row_CntAsLong)'?数定?DimPK_ArrayAsVariantDimPK_CountAsIntegerDimPK_Array_ValueAsVariant'PK数Fori=1ToCOLUMN_NUMIfTrim(WSheet.Cells(3,i))=""ThenExitForEndIfTmp_Value=Trim(WSheet.Cells(5,i))'PK行'PK行?=PKの?合IfTmp_Value=TYPE_PKThenPK_Count=PK_Count+1EndIfNext'PK配列格?を定?ReDimPK_Array_Value(PK_Count-1)'存放变量ReDimPK_Array(PK_Count-1)PK_Count=0'存放各个PK的初始值Fori=LBound(PK_Array_Value)ToUBound(PK_Array_Value)PK_Array_Value(i)=1Next'PK_Array_Value(1)=9'PKを取得Fori=1ToCOLUMN_NUMIfTrim(WSheet.Cells(3,i))=""ThenExitForEndIfTmp_Value=Trim(WSheet.Cells(5,i))'PK行'PK行?=PKの?合IfTmp_Value=TYPE_PKThenPK_Array(PK_Count)=iPK_Count=PK_Count+1EndIfNextDimColumn_PK_NoAsIntegerColumn_PK_No=0'?顺番列数组中得下标DimNoAsLongDimNo_NumAsLongDimVar_LNumAsLongNo_Num=6No=1Var_LNum=Row_StartForr=Row_StartTo(Row_Cnt+Row_Start)Forl=1ToCOLUMN_NUMTmp_Type=Trim(WSheet.Cells(3,l))Tmp_Byte=VBA.Split(Trim(WSheet.Cells(4,l)),",")Tmp_IsPk=Trim(WSheet.Cells(5,l))IfTmp_Type=""ThenVar_LNum=lExitForEndIfIfTmp_IsPk=TYPE_PKThenIfl=PK_Array(0)ThenIfLen(No&"")>Tmp_Byte(0)ThenNo=1'No_Num=No_Num+1Tmp_V=PK_Array_Value(1)+1'第二个PK值PK_Array_Value(1)=Tmp_VEndIfWSheet.Cells(r,l)=No'第一个PK赋值No=No+1Else'IfLen(No_Num&"")>Tmp_Byte(0)Then'No_Num=No_Num-1'EndIfDimTmp_Byte_iAsVariantFori=1ToUBound(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))),",")IfInt(Len(PK_Array_Value(i)&""))>Int(Tmp_Byte_i(0))ThenPK_Array_Value(i)=PK_Array_Value(i)-1If(i+1)>UBound(PK_Array)ThenForh=1ToVar_LNumWSheet.Cells(r,h).Clear'清空最后一行NextExitSubEndIfPK_Array_Value(i+1)=PK_Array_Value(i+1)+1EndIfNextFori=1ToUBound(PK_Array)Tmp_Column_i=PK_Array(i)IfTmp_Column_i=lThenWSheet.Cells(r,l)=PK_Array_Value(i)EndIfNextEndIfEndIfNextNext'MsgBox(Int(UBound(PK_Array))+1)EndSub'数字列を生成FunctionGetNumerics(NumAsInteger)AsStringFori=1ToNumTmp=GetNumericIfTmp=10ThenIfi=1ThenTmp=1ElseTmp=0EndIfEndIfGetNumerics=GetNumerics&TmpNextEndFunction'数字を生成FunctionGetNumeric()AsIntegerDoWhileGetNumeric=0GetNumeric=Int(Rnd*11)LoopEndFunctionFunctionTest()DimWSheetAsWorksheetSetWSheet=Worksheets(1)CallFunDataByPk(WSheet,6,6,50000)EndFunction
积累点点滴滴
筑起梦想的鸟巢，开始人生的长跑，领先每回的冲刺，
