根据变量格式化单元格(行高,合并)?

时间:2015-05-09 01:06:17

标签: excel excel-vba variables formatting vba

我意识到这是一个很长的镜头,但为什么不呢。我想用原始数据创建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中使用的布局 This is the layout I would like to have in Sheet2

这是来自Sheet1的原始数据,Sheet2来自 enter image description here

1 个答案:

答案 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

我的输出是 output