Итак, я пытаюсь сделать так: у меня есть отчет о номерах проводов от AutoCAD, и я беру номера проводов из отчета и переношу их в программное обеспечение принтера для этикеток проводов, чтобы наш магазин мог их распечатать.
Сделать отчет легко; Использовать программное обеспечение принтера и печатать этикетки очень просто.
Проблемы с сортировкой меток проводов в файле Excel затрудняют меня. Я могу вручную отсортировать номера проводов в их собственные файлы, но в конечном итоге я пытаюсь автоматизировать эту часть процесса.
Итак, я загрузил изображение необработанных данных рядом с 6 отсортированными и готовыми файлами Excel.
Как вы можете видеть, отчет отделяется по проволочной сетке от AutoCAD, которая по цвету проволоки и калибровке провода. Цвет провода не имеет значения. Каждый размер провода имеет свою собственную маркировочную метку, за исключением 16 и 18 калибра; они оба могут поместиться в 3,2-миллиметровую трубку, но для простоты я все равно держу их отдельно.
Таким образом, каждый набор меток проводов должен быть помещен в отдельный файл для дальнейшей обработки принтером. В конечном итоге они будут заменены на файлы .csv, но с ними сложно работать, поэтому я делаю эту часть последней, и в любом случае это просто сделать.
WireLabels - 18AWG - 3.2mm .xlsm
WireLabels - 16AWG - 3.2mm .xlsm
WireLabels - 14AWG - 3.6mm .xlsm
WireLabels - 12AWG - 4.2mm .xlsm
WireLabels - 10AWG - 5.0mm .xlsm
WireLabels - 8AWG - 6.0mm .xlsm
WireLabels - 6AWG - 8.0mm .xlsm
Я в основном пытаюсь выяснить, как пройтись по столбцу и отсортировать каждый набор номеров проводов в свой собственный файл.
Это довольно просто сделать с заданным диапазоном чисел, но с разными отчетами от AutoCAD от проекта к проекту я не могу установить конкретные диапазоны, такие как диапазон от A5 до A8, и вот где я застрял ... мы пытались выбрать диапазон до пустой ячейки после каждого бита чисел, но не можем пройти эту точку.
ЛЮБАЯ проницательность была бы потрясающей. Спасибо!
Не могли бы вы показать свой существующий код или то, что вы уже пробовали?
Sub NewSheets()
'
' Macro1 Macro
'This is is just to have a place to send the groups of numbers for now.
'They will eventually go to their own new workbooks
'
Sheets.Add After:=ActiveSheet
Sheets.Add After:=ActiveSheet
Sheets.Add After:=ActiveSheet
Sheets.Add After:=ActiveSheet
Sheets("Sheet1").Select
End Sub
Sub wires14()
Range("A64:A69").Select
Selection.Cut
Sheets("Sheet3").Select
ActiveSheet.Paste
Dim wb As Workbook
'// Set as reference to a new, one-sheet workbook. //
Set wb = Workbooks.Add(xlWBATWorksheet)
With wb
'// Skip selecting the sheet, just reference it explicitly and copy it after//
'// the blank sheet in the new wb. //
ThisWorkbook.Worksheets("sheet3").Copy After:=.Worksheets(.Worksheets.Count)
'// Kill alerts, delete the blank sheet in the new wb and turn alerts back on//
Application.DisplayAlerts = False
.Worksheets(1).Delete
Application.DisplayAlerts = True
'// SaveAs the new workbook to whatever path and close. //
.SaveAs Filename:="C:\Users\Public\Desktop\" & "14AWG - 4.6mm"
.Close False
End With
ActiveCell.Offset(rowOffset:=3, columnOffset:=3).Activate
Sheets("Sheet1").Select
End Sub
ТАК У меня есть кнопка, которая может сортировать выделение и сохранять его в виде файла, но автоматически проходит поиск и выбор
без особого вызова набора ячеек я застрял.
Этот бит, который я попробовал, может выбрать конкретный номер провода и скопировать следующие номера на новый лист, но, опять же, он только захватит указанный диапазон
и не сможет справиться с изменяющимся диапазоном.
Sub NewSheets()
'
' Macro1 Macro
'This is is just to have a place to send the groups of numbers for now.
'They will eventually go to their own new workbooks
'
Sheets.Add After:=ActiveSheet
Sheets.Add After:=ActiveSheet
Sheets.Add After:=ActiveSheet
Sheets.Add After:=ActiveSheet
Sheets("Sheet1").Select
End Sub
Sub LoopThruA()
Columns("A:A").Select
Selection.Find(What:="_18", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(1, 0).Select
Range(Selection, "A32").Select
Selection.Copy
Sheets("Sheet2").Select
Range("A1").Select
ActiveSheet.Paste
End Sub
Кроме того, BLU 18 и BLK 16 будут единственными проводами, которые разделяют рабочую книгу?
6 калибров, 8, калибровочных, 10 калибровочных, 12 калибровочных и 14 калибровочных будут иметь свою собственную рабочую книгу.
16 калибров, 18 калибров, и ВСЕ другие теги, которые не упомянуты выше, будут в той же книге.
Это связано с тем, что на этикетках «кабелей» и проводах большего диаметра используются 3,2-миллиметровые трубки, натянутые через стяжку и просто обернутые вокруг.
Все ли номера проводов всегда будут в одном и том же порядке (я понимаю, что число строк изменится).
Порядок всегда будет алфавитным / цифровым в зависимости от заголовка раздела «(Wire Label) Wire Layer: BLK_12_MTW»
Так что пример заказа будет
(Wire Label)Wire Layer:BLK_12_MTW
(Wire Label)Wire Layer:BLK_16_MTW
(Wire Label)Wire Layer:BLK_16_THHN_FW
(Wire Label)Wire Layer:BLK_18_MTW
(Wire Label)Wire Layer:BLK_2_MTW (2 gauge wire)
(Wire Label)Wire Layer:BLK_2-0_MTW (2 ought wire)
(Wire Label)Wire Layer:BLK_4_MTW
(Wire Label)Wire Layer:BLK_6_MTW
(Wire Label)Wire Layer:BLU_18_MTW
(Wire Label)Wire Layer:BLU_18_THHN_FW
(Wire Label)Wire Layer:CABLE
(Wire Label)Wire Layer:FIELDWIRE
(Wire Label)Wire Layer:RED_18_MTW
(Wire Label)Wire Layer:WHT_18_MTW
Если порядок не совпадает, изменится ли текст в их описаниях?
Первая часть (ЛЕВАЯ) текста НЕ изменится "(Wire Label) Wire Layer:".
Это единственные маркировки проводов, для которых вам когда-либо приходилось делать это, или могут быть другие?
С разными цветами могут быть провода одинакового размера, но все они будут вместе отправляться в одну и ту же новую книгу.
Мы используем 25 различных обозначений проволочных манометров и небольшой ассортимент других маркеров для маркировки проволоки.
такие как «Кабель», «Кабельная магистраль», «FieldWires», «_Multi_WIRE» и «Мультипроводник»
Размеры проводов, которые мы используем, следующие:
18
16
14
12
10
8
6
4 (4 gauge)
4-0 (4 ought)
3 (3 gauge)
3-0 (3 ought, etc...)
2
2-0
1
1-0
250
300
350
400
500
600
700
750
800
900
1000
Каждое число будет иметь обозначение в конце, например _MTW или _THHN_FW.
И возможные цвета, если это имеет значение ...
BLK
BLU
BRN
GRN
ORG
RED
WHT-BLU
WHT
YEL
Возможно ли, что для конкретной маркировки проводов вообще не может быть строк?
Нет, если на слое проводов нет проводов, его не будет в отчете.
ИЗМЕНЕНИЕ КОДА / ОБНОВЛЕНИЕ
Так что это то, над чем мы сейчас работаем. Оно работает. Это не идеально, но это делает работу.
Option Explicit
Sub DivideWireLabels()
Dim i As Long, j As Long, K As Long
Dim sht As Worksheet, ws As Worksheet
Dim wb As Workbook
Workbooks("OpenAndRunWireLabel SortTool.xls").Activate
'Add a worksheet for each category
With ActiveWorkbook
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "WireLabels - 16-18 & All Others"
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "WireLabels - 14 AWG - 3_6mm"
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "WireLabels - 12 AWG - 4_2mm"
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "WireLabels - 10 AWG - 5_0mm"
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "WireLabels - 8 AWG - 6_0mm"
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "WireLabels - 6 AWG - 8_0mm"
End With
Sheets("Sheet1").Activate
'Loop thru the column
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
'Find the wire layer cell
If InStr(Cells(i, 1).Value, "Wire Layer") > 0 Then
'if the wire layer is there, make a new sheet for it
If InStr(Cells(i, 1).Value, "_14_") > 0 Then
Set sht = Worksheets("WireLabels - 14 AWG - 3_6mm")
ElseIf InStr(Cells(i, 1).Value, "_12_") > 0 Then
Set sht = Worksheets("WireLabels - 12 AWG - 4_2mm")
ElseIf InStr(Cells(i, 1).Value, "_10_") > 0 Then
Set sht = Worksheets("WireLabels - 10 AWG - 5_0mm")
ElseIf InStr(Cells(i, 1).Value, "_8_") > 0 Then
Set sht = Worksheets("WireLabels - 8 AWG - 6_0mm")
ElseIf InStr(Cells(i, 1).Value, "_6_") > 0 Then
Set sht = Worksheets("WireLabels - 6 AWG - 8_0mm")
Else
Set sht = Worksheets("WireLabels - 16-18 & All Others")
End If
'Take the data and put it in one of the new sheets
For j = i + 1 To Cells(Rows.Count, 1).End(xlUp).Row
If Trim(Cells(j, 1).Value) <> "" Then
K = sht.Cells(sht.Rows.Count, 1).End(xlUp).Row
If Trim(sht.Cells(K, 1).Value) = "" Then
Cells(j, 1).Copy
sht.Cells(K, 1).PasteSpecial
Else
Cells(j, 1).Copy
sht.Cells(K + 1, 1).PasteSpecial
End If
Else
i = j
Exit For
End If
Next j
End If
Next i
'Clear clipboard
Application.CutCopyMode = False
'delete sheets 2 and 3
Dim s As Worksheet, t As String
Dim L As Long, M As Long
M = Sheets.Count
For L = M To 1 Step -1
t = Sheets(L).Name
If t = "Sheet2" Or t = "Sheet3" Then
Application.DisplayAlerts = False
Sheets(L).Delete
Application.DisplayAlerts = True
End If
Next L
'Create a workbook for each new worksheet
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> "Sheet1" Then
Set wb = ws.Application.Workbooks.Add
ws.Copy Before:=wb.Sheets(1)
wb.SaveAs "C:\Users\Public\Desktop\" & ws.Name, FileFormat:=xlCSV
Set wb = Nothing
End If
Next ws
ActiveWorkbook.Close SaveChanges:=True
ActiveWorkbook.Close SaveChanges:=True
ActiveWorkbook.Close SaveChanges:=True
ActiveWorkbook.Close SaveChanges:=True
ActiveWorkbook.Close SaveChanges:=True
ActiveWorkbook.Close SaveChanges:=True
ActiveWorkbook.Close SaveChanges:=True
Dim x As Variant
Dim Path As String
' Set the Path variable equal to the path of your program's installation
Path = "C:\Program Files\Nisca Corporation\M-1ProVPC\MKP5PC.exe"
x = Shell(Path, vbNormalFocus)
End Sub