|
本帖最后由 guo_zhan11 于 2017-5-22 21:59 编辑
请高手帮我改写这个代码,在VBA中什么位置加入ss = ss & "、" & arr(i, 8),能在句子之间加入“、”号?
Sub 打印()
Dim arr, brr(), crr(1 To 4, 1 To 18), d, K, i%, j%, q, Y, n, a, ss
Application.ScreenUpdating = False
Set d = CreateObject("scripting.dictionary")
arr = Sheet2.Range("A3").CurrentRegion
For i = 4 To UBound(arr)
If arr(i, 12) <> "" Then d(arr(i, 5) & "+" & arr(i, 14)) = ""
Next i
K = d.keys
a = Sheet1.Range("V3")
For j = 0 To UBound(K)
n = 0: ss = ""
For i = 4 To UBound(arr)
ReDim Preserve brr(1 To UBound(arr), 1 To 19)
If arr(i, 1) <> "" And arr(i, 5) & "+" & arr(i, 14) = a Then
n = n + 1
brr(n, 1) = arr(i, 1)
brr(n, 2) = arr(i, 2)
brr(n, 3) = arr(i, 3)
brr(n, 4) = arr(i, 4)
brr(n, 5) = arr(i, 6) & "--" & arr(i, 7)
brr(n, 10) = arr(i, 9)
brr(n, 13) = arr(i, 10)
brr(n, 16) = arr(i, 11)
brr(n, 18) = arr(i, 12)
brr(n, 19) = arr(i, 8)
End If
Next i
Next j
Y = Application.RoundUp(n / 4, 0)
For q = 1 To Y
With Sheet1
.Range("H3:J3,F5,I5:S5,B8:S11") = ""
.Range("F5") = Split(a, "+")(0)
.Range("H3") = Split(a, "+")(1)
ss = ""
For i = 1 To 4
ss = ss & "" & brr((q - 1) * 4 + i, 19)
For j = 1 To 18
If n >= (q - 1) + i Then crr(i, j) = brr((q - 1) * 4 + i, j)
Next j
Next i
.Range("I5") = ss
.Range("B8").Resize(4, 18) = crr
.Range("B2:T14").PrintPreview
.Range("B2:T14").PrintOut
End With
Next q
Sheet1.Activate
Application.ScreenUpdating = True
End Sub
Sub Optik()
Sheet1.Range("H3:J3,F5,I5:S5,B8:S11") = ""
End Sub
你自己添加一个生成按钮吧,然后添加以下相应代码。
- Sub 打印()
- Sheet1.Range("B2:T14").PrintPreview
- End Sub
- Sub 生成()
- Dim arr, brr(), crr(1 To 4, 1 To 18), d, K, i%, j%, q, Y, n, a, ss
- Application.ScreenUpdating = False
- Set d = CreateObject("scripting.dictionary")
- arr = Sheet2.Range("A3").CurrentRegion
- For i = 4 To UBound(arr)
- If arr(i, 12) <> "" Then d(arr(i, 5) & "+" & arr(i, 14)) = ""
- Next i
- K = d.keys
- a = Sheet1.Range("V3")
- For j = 0 To UBound(K)
- n = 0: ss = ""
- For i = 4 To UBound(arr)
- ReDim Preserve brr(1 To UBound(arr), 1 To 18)
- If arr(i, 1) <> "" And arr(i, 5) & "+" & arr(i, 14) = a Then
- n = n + 1
- brr(n, 1) = arr(i, 1)
- brr(n, 2) = arr(i, 2)
- brr(n, 3) = arr(i, 3)
- brr(n, 4) = arr(i, 4)
- brr(n, 5) = arr(i, 6) & "--" & arr(i, 7)
- brr(n, 10) = arr(i, 9)
- brr(n, 13) = arr(i, 10)
- brr(n, 16) = arr(i, 11)
- brr(n, 18) = arr(i, 12)
- ss = ss & "," & arr(i, 8)
- End If
- Next i
- Next j
- Y = Application.RoundUp(n / 4, 0)
- For q = 1 To Y
- With Sheet1
- .Range("E3,F5,H3:J3,I5:S5,B8:S11") = ""
- .Range("H3") = Split(a, "+")(1)
- .Range("F5") = Split(a, "+")(0)
- .Range("I5") = ss
- For i = 1 To 4
- For j = 1 To 18
- If n >= (q - 1) + i Then crr(i, j) = brr((q - 1) * 4 + i, j)
- Next j
- Next i
- .Range("B8").Resize(4, 18) = crr
- End With
- Next q
- Sheet1.Activate
- Application.ScreenUpdating = True
- End Sub
- Sub Optik()
- Sheet1.Range("E3,F5,H3:J3,I5:S5,B8:S11") = ""
- End Sub
复制代码
|
|