Ralip

VBA^3

Oct 22nd, 2021 (edited)
770
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Sub Макросик()
  2. '
  3. ' ОтчетПодготовка Макрос
  4. '
  5.  
  6. '
  7. Dim Data As Date
  8. Dim arrayShop(100) As Variant
  9. Dim arrayDate(500) As Variant
  10. Dim arrayProduct(500) As Variant
  11. Dim arraySale(400, 20, 1000) As Double
  12.  
  13. Dim Sell As Double
  14.  
  15. SizeArrayDay = 400
  16. SizeArrayShop = 20
  17. SizeArrayGoods = 1000
  18.  
  19. filepath = "c:\common\All_E4.csv"
  20. LineCount = 20000
  21. linenumber = 1
  22. shopnumber = 1
  23. Dim FlagShop As Integer
  24. FlagShop = 1
  25. Dim FlagData As Integer
  26. FlagData = 1
  27. Dim FlagProduct As Integer
  28. FlagProduct = 1
  29.  
  30. Cells(1, 16).Value = Now()
  31.  
  32. For i = 1 To SizeArrayShop
  33.     For j = 1 To SizeArrayDay
  34.         For k = 1 To SizeArrayGoods
  35.         arraySale(j, i, k) = 0
  36.         Next k
  37.     Next j
  38. Next i
  39.  
  40. Open filepath For Input As #1 ' Open file for input
  41.    Do While Not EOF(1) 'linenumber < LineCount  ' Not EOF(1)
  42.        linenumber = linenumber + 1
  43.        
  44.         Cells(1, 15).Value = linenumber
  45.        
  46.         shopnumber = shopnumber + 1
  47.         Line Input #1, Line
  48.         arrayOfElements = Split(Line, ";")
  49.  
  50.         elementnumber = 0
  51.        
  52.         Shop = arrayOfElements(5)
  53.         Dataline = arrayOfElements(6)
  54.         SellStr = arrayOfElements(7)
  55.         Product = arrayOfElements(2)
  56.         Sell = CDbl(SellStr)
  57.        
  58.         arrayOfdata = Split(Dataline, " ")
  59.         Data = arrayOfdata(0)
  60.        
  61.         dataIndex = Insert2array(arrayDate, FlagData, Data)
  62.        
  63.         shopIndex = Insert2array(arrayShop, FlagShop, Shop)
  64.        
  65.         productIndex = Insert2array(arrayProduct, FlagProduct, Product)
  66.        
  67.         arraySale(dataIndex, shopIndex, productIndex) = arraySale(dataIndex, shopIndex, productIndex) + Sell
  68.        
  69.     Loop
  70. Close #1 ' Close file.
  71.  
  72. sumForDateShop = 0
  73.  
  74. For i = 1 To FlagShop
  75.     For j = 1 To FlagData
  76.         For k = 1 To FlagProduct
  77.         sumForDateShop = sumForDateShop + arraySale(j, i, k)
  78.         Next k
  79.     Cells(j, i) = sumForDateShop
  80.     sumForDateShop = 0
  81.     Next j
  82.     Cells(1, i).Value = arrayShop(i)
  83. Next i
  84.  
  85. For i = 1 To FlagData
  86.     Cells(i, 1).Value = arrayDate(i)
  87. Next i
  88.  
  89. Cells(1, 17).Value = Now() ' Timing 4 debug
  90.  
  91. For shopIndex = 2 To FlagShop
  92.     Sheets.Add(After:=Sheets(Sheets.Count)).Name = arrayShop(shopIndex) '' Left(arrayProduct(a), 8) + Right(arrayProduct(a), 1)
  93.    For dayIndex = 1 To FlagData
  94.         For goodsIndex = 1 To FlagProduct
  95.             Cells(dayIndex, goodsIndex) = arraySale(dayIndex, shopIndex, goodsIndex)
  96.         Next goodsIndex
  97.         Cells(dayIndex, 1).Value = arrayDate(dayIndex)
  98.     Next dayIndex
  99.    
  100.     For i = 1 To FlagProduct
  101.     Cells(1, i).Value = arrayProduct(i)
  102.     Next i
  103. ' Cells(1, 1).Value = arrayProduct(a)
  104. Next shopIndex
  105. End Sub
  106.  
  107. Function Insert2array(ByRef myarray() As Variant, SizeArray As Integer, element As Variant) As Integer
  108.  
  109.         For Insert2array = 1 To SizeArray
  110.             If myarray(Insert2array) = element Then
  111.             Exit Function
  112.             End If
  113.         Next Insert2array
  114.  
  115. SizeArray = SizeArray + 1
  116. myarray(SizeArray) = element
  117.  
  118. Insert2array = SizeArray
  119.  
  120. End Function
  121.  
RAW Paste Data