-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathPower-BI-custom-sample-data.bas
5658 lines (5210 loc) · 379 KB
/
Power-BI-custom-sample-data.bas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
Attribute VB_Name = "Power-BI-custom-sample-data"
Option Compare Database
Option Explicit
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
'1、作者：焦棚子
'2、邮箱：[email protected]
'3、博客：www.jiaopengzi.com
'4、CPU：12th Gen Intel(R) Core(TM) i9-12900KF 3.20 GHz
'5、内存：RAM 32.0 GB
'6、如上电脑配置 + ShopQuantity=300 的配置：大约需要 1000 秒，每秒按照业务逻辑生成约 1万行+ 数据；生成 1000 万行+ demo数据，基本满足实战学习所用。
' 如上电脑配置 + ShopQuantity=100 的配置：大约需要 350 秒，每秒按照业务逻辑生成约 1万行+ 数据；生成 360 万行+ demo数据，基本满足实战学习所用。
' 如上电脑配置 + ShopQuantity=10 的配置：大约需要 60 秒，每秒按照业务逻辑生成约 1万行+ 数据；生成 60 万行+ demo数据，基本满足实战学习所用。
' 如上电脑配置 + ShopQuantity=5 的配置：大约需要 20 秒，每秒按照业务逻辑生成约 1万行+ 数据；生成 20 万行+ demo数据，基本满足实战学习所用。
'=====================================================================================
Public productQuantity As Long '产品数量；建议ShopQuantity∈[7,999]。
Public ShopQuantity As Long '门店数量；建议ShopQuantity∈[1,390]。
Public MaxInventoryDays As Long '入库间隔最大数；建议ShopQuantity∈[5,20]。
'=====================================================================================表名称管理
Public Const tbNameOrg As String = "D10_组织表" ' D10
Public Const tbNameRegion As String = "D20_大区表" ' D20
Public Const tbNameProvince As String = "D21_省份表" ' D21
Public Const tbNameCity As String = "D22_城市表" ' D22
Public Const tbNameDistrict As String = "D23_区县表" ' D23
Public Const tbNameProduct As String = "D30_产品表" ' D30
Public Const tbNameShop As String = "T10_门店表" ' T10
Public Const tbNameShopRental As String = "T11_门店表_租赁" ' T11
Public Const tbNameShopDecoration As String = "T12_门店表_装修" ' T12
Public Const tbNameCustomer As String = "T20_客户表" ' T20
Public Const tbNameStorage As String = "T30_入库信息表" ' T30
Public Const tbNameOrder As String = "T40_订单主表" ' T40
Public Const tbNameOrdersub As String = "T41_订单子表" ' T41
Public Const tbNameSaleTarget As String = "T50_销售目标表" ' T50
Public Const tbNameEmployee As String = "T60_员工信息表" ' T60
Public Const tbNameLaborCost As String = "T61_人工成本表" ' T61
'=====================================================================================表的字典名称和生成SQL
Public Const fLaborCostOrgID As String = "组织ID"
Public Const fLaborCostMonth As String = "月份"
Public Const fLaborCostAmount As String = "人工成本金额_元"
Public Const createTbSqlLaborCost As String = "CREATE TABLE " & tbNameLaborCost & _
"( " & vbCrLf & _
fLaborCostOrgID & " INT, " & vbCrLf & _
fLaborCostMonth & " DATE, " & vbCrLf & _
fLaborCostAmount & " INT " & vbCrLf & _
")"
Public Const fProductID As String = "产品ID"
Public Const fProductCategory As String = "产品分类"
Public Const fProductName As String = "产品名称"
Public Const fProductPrice As String = "产品销售价格"
Public Const fProductCostPrice = "产品成本价格"
Public Const createTbSqlProduct As String = "CREATE TABLE " & tbNameProduct & _
"( " & vbCrLf & _
fProductID & " VARCHAR(50) PRIMARY KEY, " & vbCrLf & _
fProductCategory & " VARCHAR(50), " & vbCrLf & _
fProductName & " VARCHAR(50), " & vbCrLf & _
fProductPrice & " INT, " & vbCrLf & _
fProductCostPrice & " INT " & vbCrLf & _
")"
'门店ID在创建是不设置ID主键,因为ID留空后置处理
Public Const fShopID As String = "门店组织ID"
Public Const fShopName As String = "门店名称"
Public Const fShopOpenDate As String = "开业日期"
Public Const fShopDistrictID As String = "区县ID"
Public Const fShopDistrict As String = "区县"
Public Const fShopLongitude As String = "纬度"
Public Const fShopLatitude As String = "经度"
Public Const fShopCloseDate As String = "闭店日期"
Public Const createTbSqlShop As String = "CREATE TABLE " & tbNameShop & _
"( " & vbCrLf & _
fShopID & " INT, " & vbCrLf & _
fShopName & " VARCHAR(50), " & vbCrLf & _
fShopOpenDate & " DATE, " & vbCrLf & _
fShopDistrictID & " INT, " & vbCrLf & _
fShopDistrict & " VARCHAR(50), " & vbCrLf & _
fShopLongitude & " FLOAT, " & vbCrLf & _
fShopLatitude & " FLOAT, " & vbCrLf & _
fShopCloseDate & " DATE " & vbCrLf & _
")"
Public Const fShopRentalShopID As String = "门店组织ID"
Public Const fShopRentalArea As String = "房屋面积_平方米"
Public Const fShopRentalPrice As String = "房屋租金_元每月每平方米"
Public Const fShopRentalStartDate As String = "起租日期"
Public Const fShopRentalEndDate As String = "止租日期"
Public Const fShopRentalIncrease As String = "年度租金涨幅"
Public Const createTbSqlShopRental As String = "CREATE TABLE " & tbNameShopRental & _
"( " & vbCrLf & _
fShopRentalShopID & " INT, " & vbCrLf & _
fShopRentalArea & " FLOAT, " & vbCrLf & _
fShopRentalPrice & " FLOAT, " & vbCrLf & _
fShopRentalStartDate & " DATE, " & vbCrLf & _
fShopRentalEndDate & " DATE, " & vbCrLf & _
fShopRentalIncrease & " FLOAT " & vbCrLf & _
")"
Public Const fShopDecorationShopID As String = "门店组织ID"
Public Const fShopDecorationStartDate As String = "装修开始日期"
Public Const fShopDecorationEndDate As String = "装修结束日期"
Public Const fShopDecorationAmount As String = "装修金额_元"
Public Const fShopDecorationYears As String = "装修折旧年限"
Public Const createTbSqlShopDecoration As String = "CREATE TABLE " & tbNameShopDecoration & _
"( " & vbCrLf & _
fShopDecorationShopID & " INT, " & vbCrLf & _
fShopDecorationStartDate & " DATE, " & vbCrLf & _
fShopDecorationEndDate & " DATE, " & vbCrLf & _
fShopDecorationAmount & " FLOAT, " & vbCrLf & _
fShopDecorationYears & " FLOAT " & vbCrLf & _
")"
Public Const fCustomerID As String = "客户ID"
Public Const fCustomerName As String = "客户名称"
Public Const fCustomerBirthday As String = "客户生日"
Public Const fCustomerGender As String = "客户性别"
Public Const fCustomerRegister As String = "注册日期"
Public Const fCustomerIndustry As String = "客户行业"
Public Const fCustomerOccupation As String = "客户职业"
Public Const createTbSqlCustomer As String = "CREATE TABLE " & tbNameCustomer & _
"( " & vbCrLf & _
fCustomerID & " VARCHAR(50) PRIMARY KEY, " & vbCrLf & _
fCustomerName & " VARCHAR(50), " & vbCrLf & _
fCustomerBirthday & " DATE, " & vbCrLf & _
fCustomerGender & " VARCHAR(50), " & vbCrLf & _
fCustomerRegister & " DATE, " & vbCrLf & _
fCustomerIndustry & " VARCHAR(50), " & vbCrLf & _
fCustomerOccupation & " VARCHAR(50) " & vbCrLf & _
")"
Public Const fStorageProductID As String = "入库产品ID"
Public Const fStorageQuantity As String = "入库产品数量"
Public Const fStorageShopID As String = "入库门店组织ID"
Public Const fStorageDate As String = "入库日期"
Public Const createTbSqlStorage As String = "CREATE TABLE " & tbNameStorage & _
"( " & vbCrLf & _
fStorageProductID & " VARCHAR(50), " & vbCrLf & _
fStorageQuantity & " INT, " & vbCrLf & _
fStorageShopID & " INT, " & vbCrLf & _
fStorageDate & " DATE " & vbCrLf & _
")"
Public Const fOrderID As String = "订单ID"
Public Const fOrderShopID As String = "门店组织ID"
Public Const fOrderDate As String = "下单日期"
Public Const fOrderSentDate As String = "送货日期"
Public Const fOrderCustomerID As String = "客户ID"
Public Const fOrderType As String = "销售渠道"
Public Const fOrderEmployeeID As String = "销售员工ID"
Public Const createTbSqlOrder As String = "CREATE TABLE " & tbNameOrder & _
"( " & vbCrLf & _
fOrderID & " VARCHAR(50) PRIMARY KEY, " & vbCrLf & _
fOrderShopID & " INT, " & vbCrLf & _
fOrderDate & " DATE, " & vbCrLf & _
fOrderSentDate & " DATE, " & vbCrLf & _
fOrderCustomerID & " VARCHAR(50), " & vbCrLf & _
fOrderType & " VARCHAR(50), " & vbCrLf & _
fOrderEmployeeID & " INT " & vbCrLf & _
")"
Public Const fOrdersubOrderID As String = "订单ID"
Public Const fOrdersubProductID As String = "产品ID"
Public Const fOrdersubPrice As String = "产品销售价格"
Public Const fOrdersubDiscount As String = "折扣比例"
Public Const fOrdersubQuantity As String = "产品销售数量"
Public Const fOrdersubAmount As String = "产品销售金额"
Public Const createTbSqlOrdersub As String = "CREATE TABLE " & tbNameOrdersub & _
"( " & vbCrLf & _
fOrdersubOrderID & " VARCHAR(50), " & vbCrLf & _
fOrdersubProductID & " VARCHAR(50), " & vbCrLf & _
fOrdersubPrice & " INT, " & vbCrLf & _
fOrdersubDiscount & " FLOAT, " & vbCrLf & _
fOrdersubQuantity & " INT, " & vbCrLf & _
fOrdersubAmount & " FLOAT, " & vbCrLf & _
"CONSTRAINT PK_" & tbNameOrdersub & " PRIMARY KEY (订单ID, 产品ID) " & vbCrLf & _
")"
Public Const fSaleTargetProvinceID As String = "省ID"
Public Const fSaleTargetProvinceName2 As String = "省简称"
Public Const fSaleTargetMonth As String = "月份"
Public Const fSaleTargetAmount As String = "销售目标"
Public Const createTbSqlSaleTarget As String = "CREATE TABLE " & tbNameSaleTarget & _
"( " & vbCrLf & _
fSaleTargetProvinceID & " INT, " & vbCrLf & _
fSaleTargetProvinceName2 & " VARCHAR(50), " & vbCrLf & _
fSaleTargetMonth & " DATE, " & vbCrLf & _
fSaleTargetAmount & " FLOAT " & vbCrLf & _
")"
Public Const fRegionID As String = "大区组织ID"
Public Const fRegionName As String = "简称"
Public Const fRegionCityID As String = "办公地城市ID"
Public Const fRegionCity As String = "办公地城市"
Public Const fRegionLongitude As String = "纬度"
Public Const fRegionLatitude As String = "经度"
Public Const createTbSqlRegion As String = "CREATE TABLE " & tbNameRegion & _
"( " & vbCrLf & _
fRegionID & " INT PRIMARY KEY, " & vbCrLf & _
fRegionName & " VARCHAR(50), " & vbCrLf & _
fRegionCityID & " INT, " & vbCrLf & _
fRegionCity & " VARCHAR(50), " & vbCrLf & _
fRegionLongitude & " FLOAT, " & vbCrLf & _
fRegionLatitude & " FLOAT " & vbCrLf & _
")"
Public Const fProvinceRegionID As String = "大区组织ID"
Public Const fProvinceID As String = "省ID"
Public Const fProvinceNameAll As String = "省全称"
Public Const fProvinceName1 As String = "省简称1"
Public Const fProvinceName2 As String = "省简称2"
Public Const fProvinceLongitude As String = "纬度"
Public Const fProvinceLatitude As String = "经度"
Public Const createTbSqlProvince As String = "CREATE TABLE " & tbNameProvince & _
"( " & vbCrLf & _
fProvinceRegionID & " INT, " & vbCrLf & _
fProvinceID & " INT, " & vbCrLf & _
fProvinceNameAll & " VARCHAR(50), " & vbCrLf & _
fProvinceName1 & " VARCHAR(50), " & vbCrLf & _
fProvinceName2 & " VARCHAR(50), " & vbCrLf & _
fProvinceLongitude & " FLOAT, " & vbCrLf & _
fProvinceLatitude & " FLOAT " & vbCrLf & _
")"
Public Const fCityProvinceID As String = "省ID"
Public Const fCityID As String = "城市ID"
Public Const fCityName As String = "城市"
Public Const fCityLongitude As String = "纬度"
Public Const fCityLatitude As String = "经度"
Public Const createTbSqlCity As String = "CREATE TABLE " & tbNameCity & _
"( " & vbCrLf & _
fCityProvinceID & " INT, " & vbCrLf & _
fCityID & " INT PRIMARY KEY, " & vbCrLf & _
fCityName & " VARCHAR(50), " & vbCrLf & _
fCityLongitude & " FLOAT, " & vbCrLf & _
fCityLatitude & " FLOAT " & vbCrLf & _
")"
Public Const fDistrictCityID As String = "城市ID"
Public Const fDistrictID As String = "区县ID"
Public Const fDistrictName As String = "区县"
Public Const fDistrictLongitude As String = "纬度"
Public Const fDistrictLatitude As String = "经度"
Public Const createTbSqlDistrict As String = "CREATE TABLE " & tbNameDistrict & _
"( " & vbCrLf & _
fDistrictCityID & " INT, " & vbCrLf & _
fDistrictID & " INT PRIMARY KEY, " & vbCrLf & _
fDistrictName & " VARCHAR(50), " & vbCrLf & _
fDistrictLongitude & " FLOAT, " & vbCrLf & _
fDistrictLatitude & " FLOAT " & vbCrLf & _
")"
Public Const fOrgID As String = "组织ID"
Public Const fOrgNameAll As String = "组织名称"
Public Const fOrgParentID As String = "上级组织ID"
Public Const fOrgName As String = "组织简称"
Public Const fOrgEmployeeID As String = "负责人ID"
Public Const createTbSqlOrg As String = "CREATE TABLE " & tbNameOrg & _
"( " & vbCrLf & _
fOrgID & " INT IDENTITY(1,1) PRIMARY KEY, " & vbCrLf & _
fOrgNameAll & " VARCHAR(255), " & vbCrLf & _
fOrgParentID & " INT, " & vbCrLf & _
fOrgName & " VARCHAR(255), " & vbCrLf & _
fOrgEmployeeID & " INT " & vbCrLf & _
")"
Public Const fEmployeeID As String = "员工ID"
Public Const fEmployeeName As String = "姓名"
Public Const fEmployeeGender As String = "性别"
Public Const fEmployeeOrgID As String = "组织ID"
Public Const fEmployeeJobTitle As String = "职务"
Public Const fEmployeeGrade As String = "职级"
Public Const fEmployeeEdu As String = "学历"
Public Const fEmployeeBirthday As String = "出生日期"
Public Const fEmployeeEntryDate As String = "入职日期"
Public Const fEmployeeResignationDate As String = "离职日期"
Public Const fEmployeeResignationReason As String = "离职原因"
Public Const createTbSqlEmployee As String = "CREATE TABLE " & tbNameEmployee & _
"( " & vbCrLf & _
fEmployeeID & " INT IDENTITY(10001,1) PRIMARY KEY, " & vbCrLf & _
fEmployeeName & " VARCHAR(50), " & vbCrLf & _
fEmployeeGender & " VARCHAR(20) DEFAULT 男, " & vbCrLf & _
fEmployeeOrgID & " INT, " & vbCrLf & _
fEmployeeJobTitle & " VARCHAR(50), " & vbCrLf & _
fEmployeeGrade & " VARCHAR(50), " & vbCrLf & _
fEmployeeEdu & " VARCHAR(50), " & vbCrLf & _
fEmployeeBirthday & " DATE, " & vbCrLf & _
fEmployeeEntryDate & " DATE, " & vbCrLf & _
fEmployeeResignationDate & " DATE NULL, " & vbCrLf & _
fEmployeeResignationReason & " VARCHAR(255) NULL " & vbCrLf & _
")"
'=====================================================================================全局变量
Public TableNameDict As Object ' 表名称字典
Public MinDateOpen As Date ' 最早开业日期
Public ProvinceID2OrgIDDict As Object ' 省份区域ID的前两位与组织ID的映射字典
Public JobTitlesArr As Variant '职务
Public GradeArr As Variant '职级
Public EduArr As Variant '学历、
Public EduDict As Object
Public EduSalaryDict As Object
Public GradeDict As Object
Public GradeSalaryDict As Object
Public ResignationArr As Variant '离职原因
Public Function InitE()
'初始化员工信息相关内容
JobTitlesArr = Array("总经理", "总经理助理", "产品总监", "采购总监", "销售总监", "销售总监", "人力资源总监", "售后服务总监", "财务总监", "大区经理", "省区经理", "门店经理", "销售顾问", "售后专员")
GradeArr = Array("总经理", "高级总监", "总监", "高级经理", "经理", "主管", "专员")
EduArr = Array("研究生", "本科", "专科", "高中")
ResignationArr = Array("个人发展", "工资原因", "工资强度", "工作内容与环境", "家庭原因", "身体原因", "违反规章制度", "劝离", "旷离", "其他原因", "试用期内解除") '试用期放在索引10
Set EduDict = CreateObject("Scripting.Dictionary")
With EduDict
.Add "PD", "博士" '博士：Doctorate (PD)
.Add "PG", "硕士" '研究生: Postgraduate (PG)
.Add "UG", "本科" '本科: Undergraduate (UG)
.Add "AD", "专科" '专科: Associate Degree(AD)
.Add "HS", "高中" '高中: High School(HS)
.Add "MS", "初中" '初中：Junior High School (JHS) 或 Middle School (MS)
.Add "PS", "小学" '小学：Primary School (PS) 或 Elementary School (ES)
End With
Set EduSalaryDict = CreateObject("Scripting.Dictionary")
With EduSalaryDict
.Add "博士", 2 '薪资系数
.Add "硕士", 1.2
.Add "本科", 1.1
.Add "专科", 1
.Add "高中", 0.9
.Add "初中", 0.8
.Add "小学", 0.7
End With
Set GradeDict = CreateObject("Scripting.Dictionary")
With GradeDict
.Add "GM", "总经理" 'General Manager (GM)
.Add "SD", "高级总监" 'Senior Director (SD)
.Add "D", "总监" 'Director (D)
.Add "SM", "高级经理" 'Senior Manager (SM)
.Add "M", "经理" 'Manager (M)
.Add "S", "主管" 'Supervisor (S)
.Add "SP", "专员" 'Specialist (SP)
End With
Set GradeSalaryDict = CreateObject("Scripting.Dictionary")
With GradeSalaryDict
.Add "总经理", Array(50000, 100000) '薪资范围
.Add "高级总监", Array(30000, 50000)
.Add "总监", Array(20000, 30000)
.Add "高级经理", Array(12000, 20000)
.Add "经理", Array(8000, 12000)
.Add "主管", Array(5000, 8000)
.Add "专员", Array(3000, 5000)
End With
End Function
Public Function InitPO()
' 初始化 省份区域ID的前两位与组织ID的映射字典
Dim i As Long
Dim ArrAddProvince
Dim ArrAddProvinceRow
Dim rows As Long
ArrAddProvince = Split(AddressProvince, ";")
ReDim ArrAddProvinceRow(0 To UBound(ArrAddProvince))
For i = 0 To UBound(ArrAddProvince)
ArrAddProvinceRow(i) = Split(ArrAddProvince(i), ",")
Next
rows = UBound(ArrAddProvinceRow)
Set ProvinceID2OrgIDDict = CreateObject("Scripting.Dictionary")
For i = 0 To rows
ProvinceID2OrgIDDict.Add CInt(Left(Trim(ArrAddProvinceRow(i)(1)), 2)), i + 15 '15依据 D20里面的默认值确定的
Next
End Function
Public Function InitTables()
' 初始化表名称字典
Set TableNameDict = CreateObject("Scripting.Dictionary")
' 将表名称作为键，对应的表的创建sql语句作为值添加到字典中
With TableNameDict
.Add tbNameProduct, createTbSqlProduct
.Add tbNameShop, createTbSqlShop
.Add tbNameShopRental, createTbSqlShopRental
.Add tbNameShopDecoration, createTbSqlShopDecoration
.Add tbNameCustomer, createTbSqlCustomer
.Add tbNameStorage, createTbSqlStorage
.Add tbNameOrder, createTbSqlOrder
.Add tbNameOrdersub, createTbSqlOrdersub
.Add tbNameSaleTarget, createTbSqlSaleTarget
.Add tbNameEmployee, createTbSqlEmployee
.Add tbNameRegion, createTbSqlRegion
.Add tbNameProvince, createTbSqlProvince
.Add tbNameCity, createTbSqlCity
.Add tbNameDistrict, createTbSqlDistrict
.Add tbNameOrg, createTbSqlOrg
.Add tbNameLaborCost, createTbSqlLaborCost
End With
End Function
Public Function SQLDrop(tableName As String) As String
' 根据表名称删除表
SQLDrop = "DROP TABLE " & tableName
End Function
Public Function TableADO(tableName As String, Sql_Drop As String, Sql_Create As String)
' 生成表
Dim Cat As Object
Dim cmd As Object
' On Error GoTo ErrorHandler
Set Cat = CreateObject("ADOX.Catalog")
Set cmd = CreateObject("ADODB.Command")
Set Cat.ActiveConnection = CurrentProject.Connection
Set cmd.ActiveConnection = CurrentProject.Connection
With cmd
.CommandTimeout = 100
' 删除已存在的表
If TableExists(tableName, Cat.tables) Then
.CommandText = Sql_Drop
.Execute
End If
' 创建新表
.CommandText = Sql_Create
.Execute
End With
CleanUp:
Set cmd = Nothing
Set Cat = Nothing
Exit Function
'ErrorHandler:
' ' 错误处理代码，可以根据需要进行相应的处理
' MsgBox "An error occurred: " & Err.Description, vbCritical, "Error"
' Resume CleanUp
End Function
Public Function TableExists(tableName As String, tables As Object) As Boolean
' 检查表是否存在
Dim tbl As Object
For Each tbl In tables
If tbl.name = tableName Then
TableExists = True
Exit Function
End If
Next
TableExists = False
End Function
Public Function ArrAddRegionDefault() As Variant
'大区默认信息
Dim ArrAdd
Dim ArrAddRow
Dim Region As String
Dim i As Long
Region = "9, 东区, 310000, 上海, 31.231518, 121.471518;" & _
"10, 西区, 510100, 成都, 30.659518, 104.065518;" & _
"11, 南区, 440100, 广州, 23.125518, 113.280518;" & _
"12, 北区, 210100, 沈阳, 41.796518, 123.429518;" & _
"13, 中区, 110000, 北京, 39.901518, 116.401518;" & _
"14, 港澳台, 810000, 香港, 22.320518, 114.173518"
ArrAdd = Split(Region, ";")
ReDim ArrAddRow(0 To UBound(ArrAdd))
For i = 0 To UBound(ArrAdd)
ArrAddRow(i) = Split(ArrAdd(i), ",")
Next
ArrAddRegionDefault = ArrAddRow
End Function
Public Function DataTableRegion()
' 根据业务逻辑生成 大区表
Dim i As Long
Dim ArrAddRow
Dim rows As Long
Dim conn As Object
Dim RsRegion As Object
ArrAddRow = ArrAddRegionDefault()
rows = UBound(ArrAddRow)
Set conn = CreateConnection
Set RsRegion = CreateRecordset(conn, tbNameRegion)
For i = 0 To rows
RsRegion.AddNew
RsRegion.Fields(fRegionID) = Trim(ArrAddRow(i)(0))
RsRegion.Fields(fRegionName) = Trim(ArrAddRow(i)(1))
RsRegion.Fields(fRegionCityID) = Trim(ArrAddRow(i)(2))
RsRegion.Fields(fRegionCity) = Trim(ArrAddRow(i)(3))
RsRegion.Fields(fRegionLongitude) = Trim(ArrAddRow(i)(4))
RsRegion.Fields(fRegionLatitude) = Trim(ArrAddRow(i)(5))
RsRegion.Update
Next
CloseConnRs conn, RsRegion
End Function
Public Function DataTableProvince()
' 根据业务逻辑生成 省份表
Dim i As Long
Dim ArrAddProvince
Dim ArrAddProvinceRow
Dim rows As Long
Dim conn As Object
Dim RsProvince As Object
ArrAddProvince = Split(AddressProvince, ";")
ReDim ArrAddProvinceRow(0 To UBound(ArrAddProvince))
For i = 0 To UBound(ArrAddProvince)
ArrAddProvinceRow(i) = Split(ArrAddProvince(i), ",")
Next
rows = UBound(ArrAddProvinceRow)
Set conn = CreateConnection
Set RsProvince = CreateRecordset(conn, tbNameProvince)
For i = 0 To rows
RsProvince.AddNew
RsProvince.Fields(fProvinceRegionID) = ArrAddProvinceRow(i)(0)
RsProvince.Fields(fProvinceID) = ArrAddProvinceRow(i)(1)
RsProvince.Fields(fProvinceNameAll) = ArrAddProvinceRow(i)(2)
RsProvince.Fields(fProvinceName1) = ArrAddProvinceRow(i)(3)
RsProvince.Fields(fProvinceName2) = ArrAddProvinceRow(i)(4)
RsProvince.Fields(fProvinceLongitude) = ArrAddProvinceRow(i)(5)
RsProvince.Fields(fProvinceLatitude) = ArrAddProvinceRow(i)(6)
RsProvince.Update
Next
CloseConnRs conn, RsProvince
End Function
Public Function DataTableCity()
' 根据业务逻辑生成 地市表
Dim i As Long
Dim ArrAddCity
Dim ArrAddCityRow
Dim rows As Long
Dim conn As Object
Dim RsCity As Object
ArrAddCity = Split(AddressCity, ";")
ReDim ArrAddCityRow(0 To UBound(ArrAddCity))
For i = 0 To UBound(ArrAddCity)
ArrAddCityRow(i) = Split(ArrAddCity(i), ",")
Next
rows = UBound(ArrAddCityRow)
Set conn = CreateConnection
Set RsCity = CreateRecordset(conn, tbNameCity)
For i = 0 To rows
RsCity.AddNew
RsCity.Fields(fCityProvinceID) = ArrAddCityRow(i)(0)
RsCity.Fields(fCityID) = ArrAddCityRow(i)(1)
RsCity.Fields(fCityName) = ArrAddCityRow(i)(2)
RsCity.Fields(fCityLongitude) = ArrAddCityRow(i)(3)
RsCity.Fields(fCityLatitude) = ArrAddCityRow(i)(4)
RsCity.Update
Next
CloseConnRs conn, RsCity
End Function
Public Function DataTableDistrict()
' 根据业务逻辑生成 区县表
Dim i As Long
Dim ArrAddDistrictRow
Dim rows As Long
Dim conn As Object
Dim RsDistrict As Object
ArrAddDistrictRow = ArrAddDistrictRowDefault()
rows = UBound(ArrAddDistrictRow)
Set conn = CreateConnection
Set RsDistrict = CreateRecordset(conn, tbNameDistrict)
For i = 0 To rows
RsDistrict.AddNew
RsDistrict.Fields(fDistrictCityID) = ArrAddDistrictRow(i)(0)
RsDistrict.Fields(fDistrictID) = ArrAddDistrictRow(i)(1)
RsDistrict.Fields(fDistrictName) = ArrAddDistrictRow(i)(2)
RsDistrict.Fields(fDistrictLongitude) = ArrAddDistrictRow(i)(3)
RsDistrict.Fields(fDistrictLatitude) = ArrAddDistrictRow(i)(4)
RsDistrict.Update
Next
CloseConnRs conn, RsDistrict
End Function
Public Function ArrAddDistrictRowDefault() As Variant
'区县默认信息
Dim ArrAdd
Dim ArrAddRow
Dim Region As String
Dim i As Long
ArrAdd = Split(AddressDistrict, ";")
ReDim ArrAddRow(0 To UBound(ArrAdd))
For i = 0 To UBound(ArrAdd)
ArrAddRow(i) = Split(ArrAdd(i), ",")
Next
ArrAddDistrictRowDefault = ArrAddRow
End Function
Public Function DataTableOrg()
' 根据业务逻辑生成 组织表
Dim i As Long
Dim ArrAddOrg
Dim ArrAddOrgRow
Dim rows As Long
Dim conn As Object
Dim RsOrg As Object
Dim RsShop As Object
Dim RsEmployee As Object
Dim myRnd As Double
Dim maxOrgID As Long
Dim dateOpen As Date
Dim employeeName As String, employeeGender As String, employeeJobTitle As String, employeeGrade As String, employeeEdu As String, employeeOrgID As Long, employeeBirthday As Date, employeeEntryDate As Date
Dim dictAllDate As Object, dictGender As Object
Set dictGender = GenderDict() '前面 448 个人性根据头像锁定
Set dictAllDate = DateStatusDict() '所有日期状态的字典
InitE
Set conn = CreateConnection
Set RsOrg = CreateRecordset(conn, tbNameOrg)
Set RsShop = CreateRecordset(conn, tbNameShop)
Set RsEmployee = CreateRecordset(conn, tbNameEmployee)
'=====================================================================================
'一级部门 和 销售大区
Const org As String = "焦棚子科技有限公司, , 总部, 10001;" & _
"总经理办公室, 1, 总经办, 10002;" & _
"产品研发中心, 1, 产品, 10003;" & _
"采购中心, 1, 采购, 10004;" & _
"销售中心, 1, 销售, 10005;" & _
"人力资源中心, 1, 人资, 10006;" & _
"售后服务中心, 1, 售后, 10007;" & _
"财务中心, 1, 财务, 10008;" & _
"东部销售大区, 5, 东区, 10009;" & _
"西部销售大区, 5, 西区, 10010;" & _
"南部销售大区, 5, 南区, 10011;" & _
"北部销售大区, 5, 北区, 10012;" & _
"中部销售大区, 5, 中区, 10013;" & _
"港澳台销售大区, 5, 港澳台, 10014"
ArrAddOrg = Split(org, ";")
ReDim ArrAddOrgRow(0 To UBound(ArrAddOrg))
For i = 0 To UBound(ArrAddOrg)
ArrAddOrgRow(i) = Split(ArrAddOrg(i), ",")
Next
rows = UBound(ArrAddOrgRow)
For i = 0 To rows
RsOrg.AddNew
RsOrg.Fields(fOrgNameAll) = Trim(ArrAddOrgRow(i)(0))
If Trim(ArrAddOrgRow(i)(1)) <> "" Then RsOrg.Fields(fOrgParentID) = Trim(ArrAddOrgRow(i)(1))
RsOrg.Fields(fOrgName) = Trim(ArrAddOrgRow(i)(2))
RsOrg.Fields(fOrgEmployeeID) = Trim(ArrAddOrgRow(i)(3))
RsOrg.Update
Next
'=====================================================================================
'省级销售区域
ArrAddOrg = Split(AddressProvince, ";")
ReDim ArrAddOrgRow(0 To UBound(ArrAddOrg))
For i = 0 To UBound(ArrAddOrg)
ArrAddOrgRow(i) = Split(ArrAddOrg(i), ",")
Next
rows = UBound(ArrAddOrgRow)
For i = 0 To rows
'===============================员工信息
myRnd = Rnd()
employeeName = generateName(myRnd)
If myRnd < 0.7 Then employeeGender = "女" Else employeeGender = "男"
employeeJobTitle = JobTitlesArr(10)
If myRnd < 0.8 Then
employeeGrade = GradeArr(3)
Else
employeeGrade = GradeArr(4)
End If
employeeEdu = EduArr(Round(Rnd() * 2, 0))
employeeBirthday = MinDateOpen - Round((Rnd() + 1) * 7500, 0)
employeeEntryDate = MinDateOpen - Round(Rnd() * 50, 0)
AddEmployeeRecord RsEmployee, employeeName, employeeGender, employeeJobTitle, employeeGrade, employeeEdu, employeeBirthday, employeeEntryDate, dictAllDate, dictGender '组织ID待定
'===============================组织
RsOrg.AddNew
RsOrg.Fields(fOrgNameAll) = "省级销售区域" + Trim(ArrAddOrgRow(i)(4))
RsOrg.Fields(fOrgParentID) = Trim(ArrAddOrgRow(i)(0))
RsOrg.Fields(fOrgName) = Trim(ArrAddOrgRow(i)(4))
RsOrg.Update
'===============================交换ID
RsOrg.Fields(fOrgEmployeeID) = RsEmployee.Fields(fEmployeeID)
RsOrg.Update
RsEmployee.Fields(fEmployeeOrgID) = RsOrg.Fields(fOrgID)
RsEmployee.Update
maxOrgID = RsOrg.Fields(fOrgID)
Next
'=====================================================================================
'门店组织
InitPO '初始化
RsShop.MoveFirst
Do Until RsShop.EOF
'赋值门店的组织ID
maxOrgID = maxOrgID + 1
RsShop.Fields(fShopID) = maxOrgID
dateOpen = RsShop.Fields(fShopOpenDate)
RsShop.Update
'组织新增
RsOrg.AddNew
RsOrg.Fields(fOrgNameAll) = "销售门店-" & RsShop.Fields(fShopName)
RsOrg.Fields(fOrgParentID) = ProvinceID2OrgIDDict(CInt(Left(RsShop.Fields(fShopDistrictID), 2))) '通过门店 区县ID 的前两位获取 上级组织ID
RsOrg.Fields(fOrgName) = RsShop.Fields(fShopName)
RsOrg.Update
'门店负责人新增
myRnd = Rnd()
employeeName = generateName(myRnd)
If myRnd < 0.7 Then employeeGender = "女" Else employeeGender = "男"
employeeJobTitle = JobTitlesArr(11)
employeeGrade = GradeArr(4)
employeeEdu = EduArr(1 + Round(Rnd() * 2, 0)) '学历要求降低
employeeBirthday = MinDateOpen - Round((Rnd() + 1) * 6000, 0) '更年轻化
employeeEntryDate = dateOpen - Round(Rnd() * 30, 0)
AddEmployeeRecord RsEmployee, employeeName, employeeGender, employeeJobTitle, employeeGrade, employeeEdu, employeeBirthday, employeeEntryDate, dictAllDate, dictGender '组织ID待定
'===============================交换ID
RsOrg.Fields(fOrgEmployeeID) = RsEmployee.Fields(fEmployeeID)
RsOrg.Update
RsEmployee.Fields(fEmployeeOrgID) = RsOrg.Fields(fOrgID)
RsEmployee.Update
RsShop.MoveNext
Loop
CloseConnRs conn, RsOrg, RsShop, RsEmployee
End Function
Public Function DataTableProduct()
' 根据业务逻辑生成 产品表
Dim i As Long
Dim myRnd As Double
Dim price As Double
Dim cost As Double
Dim conn As Object
Dim RsProduct As Object
Set conn = CreateConnection
Set RsProduct = CreateRecordset(conn, tbNameProduct)
For i = 1 To productQuantity
RsProduct.AddNew
RsProduct.Fields(fProductID) = "SKU_" & Format(i, "000000")
Randomize
myRnd = Rnd()
RsProduct.Fields(fProductCategory) = Chr(Round(myRnd * 9, 0) + 65) & "类"
RsProduct.Fields(fProductName) = "产品" & Chr(Round(myRnd * 9, 0) + 65) & "" & Format(i, "0000")
price = 1000 + myRnd * 5000
If myRnd < 0.28 Then
cost = price * 0.28
ElseIf myRnd > 0.7 Then
cost = price * myRnd * 0.8
Else
cost = price * myRnd
End If
RsProduct.Fields(fProductPrice) = Round(price, 0)
RsProduct.Fields(fProductCostPrice) = Round(cost, 0)
RsProduct.Update
Next
CloseConnRs conn, RsProduct
End Function
Public Function DataTableShop()
' 根据业务逻辑生成 门店表
Dim i As Long
Dim k As Long
Dim myRnd As Double
Dim ArrAddressDistrict
Dim ArrAddressDistrictRow
Dim ArrDictName
Dim ArrDefault7 '默认手动输入 直辖市+港澳台优先命中
Dim DictName As Object
Dim addUB0 As Long
Dim dateOpen As Date
Dim dateClose As Date
Dim conn As Object
Dim RsShop As Object
Set conn = CreateConnection
Set RsShop = CreateRecordset(conn, tbNameShop)
MinDateOpen = Format(Now, "YYYY-MM-DD")
ArrAddressDistrictRow = ArrAddDistrictRowDefault()
Set DictName = CreateObject("Scripting.Dictionary") '随机店名字，字典键名保证唯一不重复。
For i = 1 To 17576 '26*26*26
DictName(Chr(Round(Rnd() * 25, 0) + 65) & Chr(Round(Rnd() * 25, 0) + 65) & Chr(Round(Rnd() * 25, 0) + 65) & "店") = i
If DictName.Count = ShopQuantity Then
Exit For
End If
Next
ArrDictName = DictName.Keys
Set DictName = Nothing
ArrDefault7 = Array( _
Array(110101, "东城区", 39.917548, 116.418758), _
Array(120101, "和平区", 39.118328, 121.490318), _
Array(310101, "黄浦区", 31.222778, 121.471518), _
Array(500103, "渝中区", 29.556748, 106.562888), _
Array(710000, "台湾", 25.044518, 121.509518), _
Array(810001, "中西区", 22.28198088, 114.1543738), _
Array(820001, "花地玛堂区", 22.207878, 113.5528958) _
)
'优先命中四个直辖市 + 港澳台
If ShopQuantity < 8 Then
For k = 0 To ShopQuantity - 1
dateOpen = Format(Now - Round(Rnd() * 1500 + 28, 0), "YYYY-MM-DD")
If MinDateOpen > dateOpen Then MinDateOpen = dateOpen '取最小是日期
AddShopRecord RsShop, ArrDictName(k), dateOpen, CLng(ArrDefault7(k)(0)), CStr(ArrDefault7(k)(1)), Round(ArrDefault7(k)(2), 6), Round(ArrDefault7(k)(3), 6)
Next
End If
'命中前面七个城市后在生成大于 7 的数据。
If ShopQuantity > 7 Then
For k = 0 To 6
dateOpen = Format(Now - Round(Rnd() * 1500 + 28, 0), "YYYY-MM-DD")
If MinDateOpen > dateOpen Then MinDateOpen = dateOpen '取最小是日期
AddShopRecord RsShop, ArrDictName(k), dateOpen, CLng(ArrDefault7(k)(0)), CStr(ArrDefault7(k)(1)), Round(ArrDefault7(k)(2), 6), Round(ArrDefault7(k)(3), 6)
Next
For i = 8 To ShopQuantity
Randomize
myRnd = Rnd()
Randomize
addUB0 = Round(UBound(ArrAddressDistrictRow) * Rnd(), 0)
Randomize
dateOpen = Format(Now - Round(Rnd() * 1500 + 28, 0), "YYYY-MM-DD") '+28容错Dict3N
If MinDateOpen > dateOpen Then MinDateOpen = dateOpen '取最小是日期
Randomize
dateClose = Format(dateOpen + 550 + 4320 * Rnd(), "YYYY-MM-DD") '550表示至少1.5年才能关店
If dateClose > Now Then
AddShopRecord RsShop, ArrDictName(i - 1), dateOpen, CLng(ArrAddressDistrictRow(addUB0)(1)), CStr(ArrAddressDistrictRow(addUB0)(2)), Round(ArrAddressDistrictRow(addUB0)(3) + Rnd() * 0.05, 6), Round(ArrAddressDistrictRow(addUB0)(4) + Rnd() * 0.05, 6)
Else '闭店
AddShopRecord RsShop, ArrDictName(i - 1), dateOpen, CLng(ArrAddressDistrictRow(addUB0)(1)), CStr(ArrAddressDistrictRow(addUB0)(2)), Round(ArrAddressDistrictRow(addUB0)(3) + Rnd() * 0.05, 6), Round(ArrAddressDistrictRow(addUB0)(4) + Rnd() * 0.05, 6), dateClose
End If
Next
End If
CloseConnRs conn, RsShop
End Function
Public Function AddShopRecord(ByRef RsShop As Object, ByVal ShopName As String, ShopOpenDate As Date, ShopDistrictID As Long, ShopDistrict As String, ShopLongitude As Double, ShopLatitude As Double, Optional ByVal ShopCloseDate As Date)
'抽取门店新增函数
RsShop.AddNew
RsShop.Fields(fShopName) = ShopName
RsShop.Fields(fShopOpenDate) = ShopOpenDate
RsShop.Fields(fShopDistrictID) = ShopDistrictID
RsShop.Fields(fShopDistrict) = ShopDistrict
RsShop.Fields(fShopLongitude) = ShopLongitude
RsShop.Fields(fShopLatitude) = ShopLatitude
If ShopCloseDate <> CDate(0) Then RsShop.Fields(fShopCloseDate) = ShopCloseDate
RsShop.Update
End Function
Public Function DataTableShopRD()
'生成租赁和装修数据
Dim ShopRentalArea As Double
Dim ShopRentalPrice As Double
Dim dateRentalStart As Date
Dim dateRentalEnd As Date
Dim dateRsShopDecorationStart As Date
Dim dateRsShopDecorationEnd As Date
Dim depreciationPeriod As Long
Dim depreciationEndDate As Date
Dim decorationAmount As Double
Dim conn As Object
Dim RsShop As Object
Dim RsShopRental As Object
Dim RsShopDecoration As Object
Set conn = CreateConnection
Set RsShop = CreateRecordset(conn, tbNameShop)
Set RsShopRental = CreateRecordset(conn, tbNameShopRental)
Set RsShopDecoration = CreateRecordset(conn, tbNameShopDecoration)
RsShop.MoveFirst
Do Until RsShop.EOF
dateRentalStart = RsShop.Fields(fShopOpenDate) - 30 - Round(Rnd * 15, 0) '首次租赁开始日期
dateRsShopDecorationStart = dateRentalStart + Round(Rnd * 7, 0) '首次装修开始日期Format(Now, "YYYY-MM-DD")
ShopRentalArea = 600 + Rnd * 600 '租赁面积
ShopRentalPrice = 40 + Rnd * 40 '首次租赁价格
decorationAmount = ShopRentalArea * 1000 * (0.8 + (Rnd() * 0.3)) '装修金额
depreciationPeriod = 3 + Round(Rnd * 2, 0) '折旧年限
If IsNull(RsShop.Fields(fShopCloseDate)) Then
Rental: '租赁
dateRentalEnd = dateRentalStart + 3 * 365 '租赁到期日期
AddRsShopRentalRecord RsShopRental, RsShop.Fields(fShopID), Round(ShopRentalArea, 2), Round(ShopRentalPrice, 2), dateRentalStart, dateRentalEnd, Round(Rnd * 0.05, 2)
If dateRentalEnd < Now Then
dateRentalStart = dateRentalEnd + 1
ShopRentalPrice = ShopRentalPrice * 0.9 + (Rnd() * 0.2)
GoTo Rental
End If