Добрый день!
На одном из листов в книге храниться общая база, с помощью макроса с этого листа переносятся данные на другой, которые соответствуют определенным характеристикам.
Раньше данные загружались просто за весь день, а сейчас нужно, чтобы в течении дня при повторной загрузке не дублировались записи. В макросе реализован отбор, но работает непонятно [HTML]Public MC As Boolean
Public TMP As Variant
Public Rx As Variant
Public x As Variant
Public y As Variant
Public MnumberA() As Variant
Public nu As Long
'ÎÁÍÎÂËÅÍÈÅ ËÈÑÒÀ "ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ"
Public Sub Main()
'Dim dt As Date
'dt = Application.InputBox("Ââåäèòå äàòó:")
'With ActiveSheet
'MnumberA() = Range(Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(2, 3), Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(2, Columns.Count).End(xlToLeft)).Value
'Application.Transpose (MnumberA)
llastr = Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(Rows.Count, 2).End(xlUp).Row 'çàïîìíèëè ïîñëåäíþþ ñòðîêó
ReDim MnumberA(1 To llastr)
s = 0 ' ñòðîêè ìàññèâà
For y = 3 To Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(Rows.Count, 2).End(xlUp).Row 'ïåðåáèðàþ ñòðîêè íà ëèñòå
If Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(y, 2) <> " " Then ' óñëîâèå îòáîðà
s = s + 1 ' íîìåð ñòðîêè ìàññèâà
MnumberA(s) = CStr(Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(y, 2).Value) ' çàïèñü â ïåðâóþ êîëîíêó
End If
Next y
MC = True
MANK = RangeCNT("ANK", 1, 1)
For i = 2 To MANK
If Sheets("ANK").Cells(i, 11).Value = 2 And Sheets("ANK").Cells(i, 13).Value > CDate(Now()) Then 'ïðîâåðêà äàòû
If FindPos(CStr(Sheets("ANK").Cells(i, 1).Value), "ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ", 3, 2) = 0 Then
AddANK i, RangeCNT("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ", 3, 1)
End If
End If
Next i
MC = False
MsgBox ("Âûïîëíåíî!")
End Sub
Public Function poisk(MnumberA(), k) As Boolean
MANK = RangeCNT("ANK", 1, 1)
For i = 2 To MANK
x = CStr(Sheets("ANK").Cells(i, 1).Value)
For k = 3 To UBound(MnumberA)
'On Error Resume Next
If x <> CStr(MnumberA(k)) Then poisk = True: Exit Function
Next k
Next i
End Function
Function FindPos(FVal As String, SName As String, FRow As Long, FCol As Long)
For i = 0 To RangeCNT(SName, FRow, FCol)
If CStr(Sheets(SName).Cells(i + FRow, FCol).Value) = FVal Then
FindPos = i
Exit Function
End If
FindPos = 0
Next i
End Function
Function RangeCNT(SName As String, FRow As Long, FCol As Long)
i = 0
While Sheets(SName).Cells(i + FRow, FCol) <> ""
i = i + 1
Wend
RangeCNT = i + FRow
End Function
Function MaxID(SName As String, FRow, FCol)
i = 0
j = 0
While Sheets(SName).Cells(j + FRow, FCol) <> ""
If Sheets(SName).Cells(j + FRow, FCol).Value > i Then
i = Sheets(SName).Cells(j + FRow, FCol).Value
End If
j = j + 1
Wend
MaxID = i
End Function
Sub AddANK(XRow, TargetX)
MANK = RangeCNT("ANK", 1, 1)
For o = 2 To MANK
If poisk(MnumberA(), o) = True Then 'ïðîâåðêà íàëè÷èÿ çàïèñè â ðååñòðå
Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 1) = MaxID("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ", 3, 1) + 1
Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 2) = Sheets("ANK").Cells(XRow, 1)
Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 3) = Sheets("ANK").Cells(XRow, 2)
Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 5) = Sheets("Ëèñò1").Range("A2")
Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 4) = Sheets("ANK").Cells(XRow, 12)
Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 6) = "Öåíòð äîñòàâêè" 'ÊÊ Ñ ËÏ 120 Ä
Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 8) = Now()
Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 9) = Now()
Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 10) = "ÊÊ Ñ ËÏ 120 Ä"
Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 11) = Sheets("ANK").Cells(XRow, 3)
Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 12) = Sheets("ANK").Cells(XRow, 4)
Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 13) = Sheets("ANK").Cells(XRow, 5)
Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 15) = Sheets("ANK").Cells(XRow, 8)
Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 16) = Sheets("ANK").Cells(XRow, 7)
Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 17) = Sheets("ANK").Cells(XRow, 17)
Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 21) = Sheets("ANK").Cells(XRow, 16) + ", " + Sheets("ANK").Cells(XRow, 17) + ", " + Sheets("ANK").Cells(XRow, 18) + ", " + Sheets("ANK").Cells(XRow, 19) + ", " + Sheets("ANK").Cells(XRow, 20) + ", " + Sheets("ANK").Cells(XRow, 21)
Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 22) = Sheets("ANK").Cells(XRow, 13)
Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 23) = Sheets("ANK").Cells(XRow, 14)
Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 24) = Sheets("ANK").Cells(XRow, 22)
End If
Next o
End Sub
[/HTML]
Где ошибки и как исправить?