|
发表于 2013-1-15 20:06
|
显示全部楼层
本楼为最佳答案
- Option Explicit
- Sub GenNo()
- Dim Bs As Integer, Dep As Integer, Floors As Integer, H As Integer, i As Integer, j As Integer, k As Integer, arr, WB As Workbook, sh As Worksheet
- Bs = Range("B1")
- Dep = Range("B2")
- Floors = Range("B3")
- H = Range("B4")
- ReDim arr(1 To Floors + 2, 1 To Dep * H * 5)
- Set WB = Workbooks.Add
- For i = 1 To Bs
- For j = 1 To Dep * H
- arr(1, j * 5 - 4) = IIf(j Mod H, j Mod H, H)
- arr(2, j * 5 - 4) = "房号"
- arr(2, j * 5 - 3) = "附加价格位"
- arr(2, j * 5 - 2) = "单位"
- arr(2, j * 5 - 1) = "面积"
- arr(2, j * 5) = "总价"
- For k = Floors To 1 Step -1
- arr(Floors - k + 3, j * 5 - 4) = "'" & i & "-" & (j - 1) \ H + 1 & "-" & k & Format(IIf(j Mod H, j Mod H, H), "00")
- Next k
- Next j
- With WB.Sheets.Add(, Sheets(Sheets.Count))
- .Name = i & "号楼"
- With .Range("A1:E" & UBound(arr))
- .HorizontalAlignment = xlCenter
- .Borders(xlInsideVertical).LineStyle = xlContinuous
- .Borders(xlInsideHorizontal).LineStyle = xlContinuous
- With .Borders(xlEdgeTop)
- .LineStyle = xlContinuous
- .Weight = xlMedium
- End With
- With .Borders(xlEdgeBottom)
- .LineStyle = xlContinuous
- .Weight = xlMedium
- End With
- With .Borders(xlEdgeRight)
- .LineStyle = xlContinuous
- .Weight = xlMedium
- End With
- .Range("A1:E1").HorizontalAlignment = xlCenterAcrossSelection
- .Copy
- End With
- With .Range("A1").Resize(UBound(arr, 1), UBound(arr, 2))
- .Value = arr
- .PasteSpecial Paste:=xlPasteFormats
- End With
- Application.CutCopyMode = False
- End With
- Next i
- Application.DisplayAlerts = False
- For Each sh In WB.Sheets
- If sh.Cells(1, 1) = "" Then sh.Delete
- Next
- Application.DisplayAlerts = True
- End Sub
复制代码
求助,自动生成房号.zip
(18.06 KB, 下载次数: 6, 售价: 1 个金币)
|
|