Здравствуйте! Есть файл с небольшим количеством листов (10 примерно), у меня есть макрос, только выдает ошибку при запуске.В чем суть макроса, требуется произвести редизайна на всех листах файлах (условия редизайна одинаковы для всех листов). Условия задаются уже в макросе (выбрать область (область, количество строк сверху, столбцов слева). В чем ошибка? Буду благодарен, если так же подскажите как дописать, чтобы область он определял по кол-ву заполненный полей 1 строки и 1 столбца.
| Код |
|---|
Sub Redesigner()
Dim inpdata As Range, realdata As Range, ns As Worksheet
Dim i&, j&, k&, c&, r&, hc&, hr&
Dim out() As String, dataArr, hcArr, hrArr
For Each ws In Worksheets
With ws
Set inpdata = ThisWorkbook.Application.InputBox( _
prompt:="¬ыберите обрабатываемый диапазон:", Title:="¬ыбор диапазона", Type:=8)
hr = Val(InputBox("—колько строк с подпис€ми сверху?"))
hc = Val(InputBox("—колько столбцов с подпис€ми слева?"))
If inpdata.Rows.Count <= hr Or inpdata.Columns.Count <= hc Then Exit Sub
Set realdata = inpdata.Offset(hr, hc).Resize(inpdata.Rows.Count - hr, inpdata.Columns.Count - hc)
dataArr = realdata.Value
If hr Then hrArr = inpdata.Offset(0, hc).Resize(hr, inpdata.Columns.Count - hc).Value
If hc Then hcArr = inpdata.Offset(hr, 0).Resize(inpdata.Rows.Count - hr, hc).Value
ReDim out(1 To Application.CountA(realdata), 1 To hr + hc + 1)
Set ns = Worksheets.Add
For i = 1 To UBound(dataArr, 1)
For j = 1 To UBound(dataArr, 2)
If Not IsEmpty(dataArr(i, j)) Then
k = k + 1
For c = 1 To hc: out(k, c) = hcArr(i, c): Next c
For r = 1 To hr: out(k, c + r - 1) = hrArr(r, j): Next r
out(k, c + r - 1) = dataArr(i, j)
End If
Next j, i
ns.Cells(2, 1).Resize(UBound(out, 1), UBound(out, 2)) = out
End with ws
Next ws
End Sub
|
Изменено: - 27.05.2022 14:23:52
