Igor K.andClaude Opus 5.5
a6a3d5d6cd
- VBS и Python: в итоговом CSV код КИЗ обрезается до первых 31 символа (код без криптохвоста: 01 + GTIN + 21 + серийный номер); более короткий код остаётся как есть, с замечанием в отчёте. Копия kiz_to_csv.py в портативном комплекте обновлена так же. - README.md: инструкция на русском, переписана проще и яснее; Инструкция_экспорт_CSV.docx пересобрана из того же текста, с настоящими заголовками и списками. - AGENTS.md, CLAUDE.md, .agents/ (скилл kiz-testing, папки plans и reports). - .gitignore для .DS_Store; .gitattributes хранит файлы без изменения концов строк (.bat и .vbs нужны CRLF). Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
374 lines
26 KiB
Plaintext
374 lines
26 KiB
Plaintext
Option Explicit
|
||
|
||
Const KIZ_LEN = 31 ' КИЗ без криптохвоста: "01" + GTIN (14) + "21" + серийный номер (13)
|
||
|
||
' ============================================================
|
||
' xlsx/xls/xlsm: сопоставление отсканированных КИЗ с товарной
|
||
' накладной + экспорт CSV (UTF-8, разделитель - запятая,
|
||
' последняя колонка в двойных кавычках, если в ней есть запятая)
|
||
' Windows 7 + Excel 2007/2010/2013/2016
|
||
'
|
||
' Что делает:
|
||
' 1. Спрашивает два файла (окна выбора; файл КИЗ можно также
|
||
' перетащить на скрипт):
|
||
' файл 1 - товарная накладная (ТОРГ-12),
|
||
' файл 2 - таблица с отсканированными КИЗ (последняя
|
||
' заполненная колонка - коды DataMatrix).
|
||
' 2. Из каждого КИЗ извлекает GTIN (DataMatrix: "01" + 14 цифр).
|
||
' 3. Ищет GTIN в колонке B ("Наименование") накладной, начиная с ряда 19:
|
||
' GTIN - последнее "слово" значения (текст после последнего пробела).
|
||
' 4. Из найденного ряда накладной берет:
|
||
' название - колонка B, текст до последнего пробела,
|
||
' цена - колонка L,
|
||
' ставка НДС - колонка N (вписывается со знаком %).
|
||
' 5. Вписывает в файл 2 напротив КИЗ:
|
||
' B - название, C - цена, D - 1, E - 796, F - ставка НДС (%),
|
||
' G - "КИЗ". Колонки B, C, F получают текстовый формат,
|
||
' никаких преобразований чисел Excel не делает.
|
||
' КИЗ в CSV обрезается до первых 31 символа (код без криптохвоста);
|
||
' более короткий КИЗ остается как есть, с замечанием в отчете.
|
||
' 6. Сверяет: число КИЗ каждого GTIN в файле 2 должно совпадать
|
||
' с количеством из колонки K накладной.
|
||
' 7. Сохраняет CSV рядом с файлом 2 (то же имя, .csv) и показывает
|
||
' отчет о сверке. Сам файл 2 на диске не изменяется.
|
||
' ============================================================
|
||
|
||
Dim fso, excelApp
|
||
Dim fileKiz, fileNakl, csvPath, reportPath
|
||
Dim wb1, ws1, ur1, lastRow1
|
||
Dim wb2, ws2, ur2, firstRow2, nRows2, lastCol2
|
||
Dim r, c, v, s, gtin, key, rowNakl
|
||
Dim name1, price1, vat1, i
|
||
Dim dictRow, dictQty, dictFound, dictShow, dictKiz
|
||
Dim kizTotal, kizMatched
|
||
Dim warnText, okText
|
||
Dim out, line
|
||
|
||
Set fso = CreateObject("Scripting.FileSystemObject")
|
||
|
||
Set excelApp = CreateObject("Excel.Application")
|
||
excelApp.Visible = False
|
||
excelApp.DisplayAlerts = False
|
||
excelApp.ScreenUpdating = False
|
||
excelApp.EnableEvents = False
|
||
|
||
' --- выбор файлов ---
|
||
fileKiz = ""
|
||
If WScript.Arguments.Count > 0 Then
|
||
If fso.FileExists(WScript.Arguments(0)) Then fileKiz = WScript.Arguments(0)
|
||
End If
|
||
If fileKiz = "" Then
|
||
fileKiz = PickFile("Выберите файл 2 - таблица с отсканированными КИЗ")
|
||
If fileKiz = "" Then CleanQuit
|
||
End If
|
||
|
||
fileNakl = PickFile("Выберите файл 1 - товарная накладная (ТОРГ-12)")
|
||
If fileNakl = "" Then CleanQuit
|
||
|
||
Set dictRow = CreateObject("Scripting.Dictionary") ' key GTIN -> ряд накладной
|
||
Set dictQty = CreateObject("Scripting.Dictionary") ' key GTIN -> количество (K)
|
||
Set dictFound = CreateObject("Scripting.Dictionary") ' key GTIN -> число КИЗ в файле 2
|
||
Set dictShow = CreateObject("Scripting.Dictionary") ' key GTIN -> GTIN для показа
|
||
Set dictKiz = CreateObject("Scripting.Dictionary") ' ряд файла 2 -> КИЗ без криптохвоста
|
||
|
||
' --- файл 1: накладная (только чтение, держим открытой до конца обработки) ---
|
||
Set wb1 = excelApp.Workbooks.Open(fileNakl, 0, True)
|
||
Set ws1 = wb1.Worksheets(1)
|
||
Set ur1 = ws1.UsedRange
|
||
lastRow1 = ur1.Row + ur1.Rows.Count - 1
|
||
|
||
Dim gtinB
|
||
|
||
For r = 19 To lastRow1
|
||
gtinB = GtinFromName(ws1.Cells(r, 2).Value) ' колонка B - "Наименование", GTIN после последнего пробела
|
||
key = NormGtin(gtinB)
|
||
If Len(key) >= 8 Then
|
||
If Not dictRow.Exists(key) Then
|
||
dictRow.Add key, r
|
||
If IsNumeric(ws1.Cells(r, 11).Value) Then ' колонка K - количество
|
||
dictQty.Add key, CDbl(ws1.Cells(r, 11).Value)
|
||
End If
|
||
End If
|
||
End If
|
||
Next
|
||
|
||
If dictRow.Count = 0 Then
|
||
MsgBox "В колонке B (" & Chr(34) & "Наименование" & Chr(34) & ") накладной, начиная с ряда 19," & vbCrLf & _
|
||
"не найдено ни одного GTIN (код после последнего пробела)." & vbCrLf & vbCrLf & _
|
||
"Проверьте, что это файл товарной накладной.", vbExclamation, "Сопоставление КИЗ"
|
||
CleanQuit
|
||
End If
|
||
|
||
' --- файл 2: таблица с КИЗ ---
|
||
Set wb2 = excelApp.Workbooks.Open(fileKiz)
|
||
Set ws2 = wb2.Worksheets(1)
|
||
Set ur2 = ws2.UsedRange
|
||
firstRow2 = ur2.Row
|
||
nRows2 = ur2.Rows.Count
|
||
lastCol2 = ur2.Column + ur2.Columns.Count - 1 ' абсолютный номер последней колонки (КИЗ)
|
||
|
||
kizTotal = 0
|
||
kizMatched = 0
|
||
warnText = ""
|
||
|
||
For r = 1 To nRows2
|
||
v = ws2.Cells(firstRow2 + r - 1, lastCol2).Value
|
||
s = CleanText(v)
|
||
If s <> "" Then
|
||
gtin = ExtractGTIN(s)
|
||
If gtin = "" Then
|
||
warnText = warnText & "Ряд " & (firstRow2 + r - 1) & ": не удалось извлечь GTIN из кода КИЗ." & vbCrLf
|
||
Else
|
||
kizTotal = kizTotal + 1
|
||
dictKiz.Add firstRow2 + r - 1, Left(s, KIZ_LEN)
|
||
If Len(s) < KIZ_LEN Then
|
||
warnText = warnText & "Ряд " & (firstRow2 + r - 1) & ": КИЗ короче " & KIZ_LEN & _
|
||
" символов (" & Len(s) & "), записан как есть." & vbCrLf
|
||
End If
|
||
key = NormGtin(gtin)
|
||
If Not dictFound.Exists(key) Then
|
||
dictFound.Add key, 0
|
||
dictShow.Add key, gtin
|
||
End If
|
||
dictFound(key) = dictFound(key) + 1
|
||
|
||
If dictRow.Exists(key) Then
|
||
rowNakl = dictRow(key)
|
||
|
||
' --- название: колонка B накладной, текст до последнего пробела ---
|
||
s = CleanText(ws1.Cells(rowNakl, 2).Value)
|
||
name1 = ""
|
||
i = InStrRev(s, " ")
|
||
If i > 0 Then name1 = Trim(Left(s, i - 1))
|
||
|
||
' --- цена: колонка L ---
|
||
price1 = NumText(ws1.Cells(rowNakl, 12).Value)
|
||
|
||
' --- ставка НДС: колонка N, обязательно со знаком % ---
|
||
s = NumText(ws1.Cells(rowNakl, 14).Value)
|
||
If s <> "" Then
|
||
If Right(s, 1) <> "%" Then s = s & "%"
|
||
End If
|
||
vat1 = s
|
||
|
||
' --- вписываем в файл 2 (B, C, F - текстовый формат) ---
|
||
With ws2
|
||
.Cells(firstRow2 + r - 1, 2).NumberFormat = "@"
|
||
.Cells(firstRow2 + r - 1, 2).Value = CStr(name1)
|
||
.Cells(firstRow2 + r - 1, 3).NumberFormat = "@"
|
||
.Cells(firstRow2 + r - 1, 3).Value = CStr(price1)
|
||
.Cells(firstRow2 + r - 1, 4).Value = 1
|
||
.Cells(firstRow2 + r - 1, 5).Value = 796
|
||
.Cells(firstRow2 + r - 1, 6).NumberFormat = "@"
|
||
.Cells(firstRow2 + r - 1, 6).Value = CStr(vat1)
|
||
.Cells(firstRow2 + r - 1, 7).Value = "КИЗ"
|
||
End With
|
||
kizMatched = kizMatched + 1
|
||
Else
|
||
warnText = warnText & "Ряд " & (firstRow2 + r - 1) & ": GTIN " & gtin & _
|
||
" не найден в колонке B накладной (ряды с 19)." & vbCrLf
|
||
End If
|
||
End If
|
||
End If
|
||
Next
|
||
|
||
wb1.Close False
|
||
|
||
' --- сверка количества: файл 2 vs колонка K накладной ---
|
||
okText = ""
|
||
For Each key In dictFound
|
||
If dictRow.Exists(key) Then
|
||
If dictQty.Exists(key) Then
|
||
If CLng(dictQty(key)) = CLng(dictFound(key)) Then
|
||
okText = okText & "GTIN " & dictShow(key) & ": " & dictFound(key) & _
|
||
" шт. = накладной (K) " & CStr(dictQty(key)) & " - OK" & vbCrLf
|
||
Else
|
||
warnText = warnText & "GTIN " & dictShow(key) & ": КИЗ в файле " & dictFound(key) & _
|
||
" шт., в накладной (K) " & CStr(dictQty(key)) & " - НЕ СОВПАДАЕТ" & vbCrLf
|
||
End If
|
||
Else
|
||
warnText = warnText & "GTIN " & dictShow(key) & ": в ряде накладной не указано количество (K)." & vbCrLf
|
||
End If
|
||
End If
|
||
Next
|
||
|
||
' --- экспорт CSV (UTF-8; последняя колонка в кавычках при наличии запятой) ---
|
||
out = ""
|
||
For r = 1 To nRows2
|
||
line = ""
|
||
For c = 1 To lastCol2
|
||
v = ws2.Cells(firstRow2 + r - 1, c).Value
|
||
If c = lastCol2 Then
|
||
Dim lastField
|
||
If dictKiz.Exists(firstRow2 + r - 1) Then
|
||
lastField = dictKiz(firstRow2 + r - 1) ' КИЗ без криптохвоста
|
||
Else
|
||
lastField = FormatField(v)
|
||
End If
|
||
If InStr(lastField, ",") > 0 Then
|
||
line = line & """" & Replace(lastField, """", """""") & """"
|
||
Else
|
||
line = line & lastField
|
||
End If
|
||
Else
|
||
line = line & FormatField(v)
|
||
End If
|
||
If c < lastCol2 Then line = line & ","
|
||
Next
|
||
If r < nRows2 Then
|
||
out = out & line & vbCrLf
|
||
Else
|
||
out = out & line
|
||
End If
|
||
Next
|
||
|
||
csvPath = fso.GetParentFolderName(fileKiz) & "\" & fso.GetBaseName(fileKiz) & ".csv"
|
||
reportPath = fso.GetParentFolderName(fileKiz) & "\" & fso.GetBaseName(fileKiz) & "_report.txt"
|
||
|
||
WriteUtf8 csvPath, out
|
||
WriteUtf8 reportPath, "Отчет сопоставления КИЗ" & vbCrLf & _
|
||
"Накладная: " & fileNakl & vbCrLf & _
|
||
"Файл КИЗ: " & fileKiz & vbCrLf & vbCrLf & _
|
||
"Обработано КИЗ: " & kizTotal & ", сопоставлено: " & kizMatched & vbCrLf & vbCrLf & _
|
||
"Сверка количества (файл КИЗ vs колонка K накладной):" & vbCrLf & okText & vbCrLf & _
|
||
"Замечания:" & vbCrLf & warnText
|
||
|
||
wb2.Close False ' файл 2 на диске не изменяем
|
||
|
||
' --- итоговое окно ---
|
||
If warnText = "" Then
|
||
MsgBox "Готово. Обработано КИЗ: " & kizTotal & ", сопоставлено: " & kizMatched & "." & vbCrLf & _
|
||
"Все количества совпали с накладной." & vbCrLf & vbCrLf & _
|
||
"CSV: " & csvPath, vbInformation, "Сопоставление КИЗ"
|
||
Else
|
||
MsgBox "Готово, но есть замечания (подробности в отчете):" & vbCrLf & reportPath & vbCrLf & vbCrLf & _
|
||
"Обработано КИЗ: " & kizTotal & ", сопоставлено: " & kizMatched & ".", vbExclamation, "Сопоставление КИЗ"
|
||
End If
|
||
|
||
CleanQuit
|
||
|
||
' ============================================================
|
||
' Функции
|
||
' ============================================================
|
||
|
||
Function PickFile(title)
|
||
Dim res
|
||
res = excelApp.GetOpenFilename( _
|
||
"Excel файлы (*.xlsx;*.xls;*.xlsm),*.xlsx;*.xls;*.xlsm", 1, title)
|
||
If VarType(res) = vbBoolean Then
|
||
PickFile = ""
|
||
Else
|
||
PickFile = CStr(res)
|
||
End If
|
||
End Function
|
||
|
||
Function CleanText(v)
|
||
Dim t
|
||
t = CStr(v)
|
||
t = Replace(t, vbCr, "")
|
||
t = Replace(t, vbLf, "")
|
||
CleanText = Trim(t)
|
||
End Function
|
||
|
||
' Из DataMatrix-строки КИЗ извлекает GTIN: "01" + 14 цифр
|
||
Function ExtractGTIN(s)
|
||
Dim t
|
||
t = Replace(s, " ", "")
|
||
If Len(t) >= 16 Then
|
||
If Left(t, 2) = "01" Then
|
||
If IsNumeric(Mid(t, 3, 14)) Then
|
||
ExtractGTIN = Mid(t, 3, 14)
|
||
Exit Function
|
||
End If
|
||
End If
|
||
End If
|
||
ExtractGTIN = ""
|
||
End Function
|
||
|
||
' Из колонки B накладной ("Наименование ... GTIN") извлекает GTIN:
|
||
' текст после последнего пробела, только цифры
|
||
Function GtinFromName(v)
|
||
Dim t, i
|
||
t = CleanText(v)
|
||
i = InStrRev(t, " ")
|
||
If i > 0 Then
|
||
GtinFromName = DigitsOnly(Mid(t, i + 1))
|
||
Else
|
||
GtinFromName = DigitsOnly(t)
|
||
End If
|
||
End Function
|
||
|
||
' Оставляет только цифры; числовые ячейки читает без экспоненты
|
||
Function DigitsOnly(v)
|
||
Dim t, ch, res
|
||
res = ""
|
||
If VarType(v) <> 8 And IsNumeric(v) Then
|
||
t = FormatNumber(CDbl(v), 0, vbFalse, vbFalse, vbFalse)
|
||
Else
|
||
t = CStr(v)
|
||
End If
|
||
For i = 1 To Len(t)
|
||
ch = Mid(t, i, 1)
|
||
If ch >= "0" And ch <= "9" Then res = res & ch
|
||
Next
|
||
DigitsOnly = res
|
||
End Function
|
||
|
||
' Убирает ведущие нули для сравнения (GTIN может храниться как 14-значный
|
||
' код с нулем или как 13-значное число без него)
|
||
Function NormGtin(g)
|
||
Dim t
|
||
t = g
|
||
Do While Left(t, 1) = "0" And Len(t) > 1
|
||
t = Mid(t, 2)
|
||
Loop
|
||
NormGtin = t
|
||
End Function
|
||
|
||
' Число как текст с точкой в десятичной части (358.18, а не 358,18)
|
||
Function NumText(v)
|
||
Dim t
|
||
If IsNumeric(v) Then
|
||
t = CStr(CDbl(v))
|
||
t = Replace(t, ",", ".")
|
||
If Right(t, 2) = ".0" Then t = Left(t, Len(t) - 2) ' 10.0 -> 10
|
||
NumText = t
|
||
Else
|
||
t = Trim(CStr(v))
|
||
If Right(t, 1) = "%" Then t = Left(t, Len(t) - 1)
|
||
NumText = t
|
||
End If
|
||
End Function
|
||
|
||
Function FormatField(v)
|
||
Dim t
|
||
Select Case VarType(v)
|
||
Case 0, 1 ' vbEmpty, vbNull
|
||
FormatField = ""
|
||
Case 2, 3, 4, 5, 6 ' числа: точка как разделитель
|
||
t = CStr(CDbl(v))
|
||
FormatField = Replace(t, ",", ".")
|
||
Case Else ' текст как есть
|
||
FormatField = CStr(v)
|
||
End Select
|
||
End Function
|
||
|
||
Sub WriteUtf8(path, text)
|
||
Dim st
|
||
Set st = CreateObject("ADODB.Stream")
|
||
st.Type = 2
|
||
st.Charset = "utf-8"
|
||
st.Open
|
||
st.WriteText text
|
||
st.SaveToFile path, 2
|
||
st.Close
|
||
End Sub
|
||
|
||
Sub CleanQuit
|
||
On Error Resume Next
|
||
wb2.Close False
|
||
wb1.Close False
|
||
excelApp.Quit
|
||
WScript.Quit
|
||
End Sub
|