Всем доброго времени суток!
Помогите, пожалуйста, где нужно что поменять чтобы нумерация в шапке начиналась не с 1, а с любого числа, которое я напишу?
Заранее благодарю за помощь
Sub Main_Card(bDelete As Boolean)
Dim aData()
Dim lRw As Long
With ws0
lRw = .Cells(.Rows.Count, 2).End(xlUp).Row: If lRw < 7 Then GoTo nxt_
aData = .Range("A1:S" & lRw).Value
End With
With Application: .ScreenUpdating = False: .DisplayAlerts = False: End With
If bDelete = True Then Call DeleteCard
Call ClearData(aData)
Call SplitData(aData)
With Application: .ScreenUpdating = True: .DisplayAlerts = True: End With
nxt_:
Set pRng = Nothing
End Sub
Sub DeleteCard()
Dim sht As Worksheet
If Worksheets.Count > 4 Then
If MsgBox("Подтвердите удаление карт", 64 + vbYesNo, "УДАЛЕНИЕ КАРТ") = vbNo Then Exit Sub
For Each sht In Worksheets
If sht.Name <> ws0.Name Then
If sht.Name <> ws1.Name Then
If sht.Name <> wsList.Name Then
If sht.Name <> wsListDep.Name Then
If sht.Name <> wsActivity.Name Then
sht.Delete
End If
End If
End If
End If
End If
Next sht
End If
End Sub
Sub ClearData(aData())
Dim i As Long
For i = 7 To UBound(aData)
aData(i, 2) = Replace(Replace(aData(i, 2), ", ", ","), ".", ",")
Next i
End Sub
Sub DepInMassive(aDep())
Dim lRw As Long, lClmn As Long
With wsListDep
lRw = .UsedRange.Rows.Count + .UsedRange.Row - 1
lClmn = .Cells(1, .Columns.Count).End(xlToLeft).Column
aDep = .Range("A1").Resize(lRw, lClmn).Value
End With
End Sub
Sub SplitData(aData())
Dim aTmp(), aDep(), aHead(1 To 3, 1 To 1)
Dim aSpl, aSplPos
Dim dDate As Date
Dim sDep As String, sStrDep As String
Dim i As Long, n As Long, k As Long, j As Long ', p As Long
If ws1.Range("C7").Value = "" Then
dDate = Date
Else
dDate = ws1.Range("C7").Value
End If
Call DepInMassive(aDep)
For j = 1 To UBound(aDep, 2) Step 2
sDep = aDep(1, j) ' отдел
For i = 3 To UBound(aDep)
If aDep(i, j) = Empty Then Exit For
aHead(1, 1) = dDate
aHead(2, 1) = aDep(i, j)
aHead(3, 1) = sDep
ReDim aTmp(1 To 100, 1 To 7)
k = 0
For n = 7 To UBound(aData)
If InStr(aData(n, 2), sDep) Then
sStrDep = fStrDep(aData(n, 2), sDep)
If InStr(sStrDep, aDep(i, j) & ",") Then
aData(n, 2) = Replace(aData(n, 2), sStrDep, Replace(sStrDep, aDep(i, j) & ",", ""))
k = k + 1
aTmp(k, 1) = aData(n, 6): aTmp(k, 2) = aData(n, 8)
aTmp(k, 3) = aData(n, 11): aTmp(k, 4) = aData(n, 13)
aTmp(k, 5) = aData(n, 15): aTmp(k, 6) = aData(n, 17)
aTmp(k, 7) = aData(n, 10)
End If
End If
Next n
If k > 0 Then Call NewCard(aHead, aTmp, k)
Next i
Next j
End Sub
Function fStrDep(ByVal sText As String, sDep As String) As String
Dim aSpl
Dim j As Long
aSpl = Split(sText, Chr$(10))
For j = 0 To UBound(aSpl)
If InStr(aSpl(j), sDep) Then
fStrDep = aSpl(j)
Exit Function
End If
Next j
End Function
Sub NewCard(aHead(), aTmp(), k As Long)
ws1.Copy After:=Sheets(Sheets.Count)
With Sheets(Sheets.Count)
.Visible = xlSheetVisible
.Range("C7:C9").Value = aHead
.Range("C10").Value = Range("C10").Value
.Range("A16").Resize(k, 7).Value = aTmp
If pFlag = True Then
pRng.Copy .Cells(16 + k, 1).Resize(pRng.Rows.Count, 7)
End If
End With
End Sub
Sub NumCard()
Dim sTmp As String, sTxt As String, sTxt5 As String
Dim j As Long
If Worksheets.Count < 6 Then Exit Sub
sTmp = wsList.Range("B2").Value
sTxt = ws1.Range("A1").Value
sTxt5 = Left$(sTxt, 5)
For j = 6 To Worksheets.Count
With Worksheets(j)
If Left(.Range("A1").Value, 5) = sTxt5 Then .Range("A1").Value = sTxt & Replace(sTmp, "*", j - 5)
End With
Next j
End Sub
файл я ваш взял, он у меня есть, можете его больше не выкладывать
вопрос у вас большой, я занят другими делами, скорее всего не смогу помочь
Номера карт проставляются какой кнопкой? №№ карт?
Если, честно, я не знаю, там как-то из макроса собирается заголовок, потом в своде можно нажать вверху на меню №№ карт и номера добавляются автоматически
После какой кнопки появляются номера карт? Вы же знаете, на какую кнопку щёлкаете?
Свод-меню-создать карты-да-создать карты- меню-№№ карт и после появляются номера
Номера появляются после щелчка по какой-то кнопке?
Сначала номеров нет, а затем вы щёлкаете и номера появляются. Вы не можете понять, в какой момент появляются номера?
меню-№№ карт и после появляются номера