我意识到这是一个很长的镜头,但为什么不呢。我想用原始数据创建Sheet1:
Class | Info
1 | Subject
2 | Topic
3 | Unique data
3 | Unique data
3 | Unique data
1 | Subject
2 | Topic
3 | Unique data
然后在Sheet2中我想获得Class#并相应地格式化它:
-If Class=1 then: 1 row, Top and Bottom border
-If Class=2 then: Merge 2 rows of cells, text = 16pt, top & btm border
-If Class=3 then: Merge 3 rows of cells, text = 24 pt, top & btm border
有没有人知道如何在Excel上执行此操作?感谢
修改
澄清:我正在尝试为课程制作一个pharm列表,而不必花费几天的直接格式化。
这是我想在Sheet2中使用的布局
这是来自Sheet1的原始数据,Sheet2来自
答案 0 :(得分:1)
Sub ert()
'ws As Worksheet
Dim ws As Worksheet, i As Long
Set ws = Worksheets("Munka2") 'name of the worksheet with data
'if you don't start from scratch every time then a cleaning sub reference should be here
i = 1
LastRow = ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 'the last row in the worksheet
While i <= LastRow
If Not ws.Range("A" & i).Value2 = "" Then 'if the class value is specified and not a dummy row
Select Case ws.Range("A" & i).Value2 'class value
Case 1 'if it's class1
With ws.Range("B" & i & ":I" & i) 'merges from B to I column, top and bottom border, grey background
.Merge
.Borders(xlEdgeBottom).Weight = xlThin
.Borders(xlEdgeTop).Weight = xlThin
'.Borders(xlEdgeLeft).Weight = xlThin
'.Borders(xlEdgeRight).Weight = xlThin
.Interior.Color = RGB(180, 180, 180)
'.Font.Name = "Calibri" 'not specified, you may vary them along the lines of: see below
'.Font.Size = 11
'.Font.Bold = True
'.Font.Italic = True
End With
Case 2 'inserts a row then merges the two rows from B to D, adds top, bottom, left and right borders, font size: 16 pt
ws.Range(i + 1 & ":" & i + 1).Rows.Insert 'inserts a row after this one
With ws.Range("B" & i & ":D" & i + 1)
.Merge
.Borders(xlEdgeBottom).Weight = xlThin
.Borders(xlEdgeTop).Weight = xlThin
.Borders(xlEdgeLeft).Weight = xlThin
.Borders(xlEdgeRight).Weight = xlThin
'.Interior.Color = RGB(180, 180, 180)
'.Font.Name = "Calibri" 'not specified, you may vary them along the lines of: see below
.Font.Size = 16
'.Font.Bold = True
'.Font.Italic = True
End With
Case 3 'inserts two rows, merges B to C, all four borders, font size: 24 pt
ws.Range(i + 1 & ":" & i + 1).Rows.Insert 'inserts two rows after this one
ws.Range(i + 1 & ":" & i + 1).Rows.Insert
With ws.Range("B" & i & ":C" & i + 2)
.Merge
.Borders(xlEdgeBottom).Weight = xlThin
.Borders(xlEdgeTop).Weight = xlThin
.Borders(xlEdgeLeft).Weight = xlThin
.Borders(xlEdgeRight).Weight = xlThin
'.Interior.Color = RGB(180, 180, 180)
'.Font.Name = "Calibri" 'not specified, you may vary them along the lines of: see below
.Font.Size = 24
'.Font.Bold = True
'.Font.Italic = True
End With
Case Else
'if there is a row in which class is defined but doesn't match your cases then it should warn you
MsgBox "You have messed up something"
ws.Select
ws.Range("A" & i).Select
End Select
End If
i = i + 1
LastRow = ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 'the number of rows may have changed
Wend
End Sub
使用示例输入
| A | B
1 | 1 | Hyper-Thyroid State
2 | 2 | Antithyroid Drugs
3 | 3 | Thioureylenes
4 | 4 | Propylthiouracil
我的输出是