VBA 用于格式化工作表数据的宏以创建 table

Question

我有以下未格式化的文件，在创建 table 之前，我需要以某种方式在 vba 中对其进行格式化。宏需要：

创建一个 header 行，其中包含上次使用前的日期列，并移至第 1 行 headers
将 B 列中以蓝色突出显示的组名称移至预算和实际的 A 列
删除空白行（已有此代码）
转成table（已有此码）

有没有简单的方法来做到这一点？这个文件每个月都会被复制到某个地方，我必须手动调整所有格式，并且有数百行这样。

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Prompts user for location of the Member Count File, then
'               copies it in the Active Workbook & Formats File
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub CopyMemberData()
Dim wb1 As Workbook, wb2 As Workbook
Dim my_Filename
Dim x As Long
    
Set wb1 = ThisWorkbook 'CYTD File

Application.ScreenUpdating = False

'**************Get File Location for Member Count Data
my_Filename = Application.GetOpenFilename(fileFilter:="Excel Files,*.xl*;*.xm*", Title:="Open Membership Analysis File")

If my_Filename = False Then
    Exit Sub
End If

Set wb2 = Workbooks.Open(my_Filename) 'Membership Analysis File

'**************Copy Membership Data Details
wb2.Sheets("Membership data_Charts by LOB").Cells.Copy _
wb1.Sheets("MemberCount").Range("A1")
wb2.Close

'**************Format Sheet
With ActiveSheet

    'Create Header Row
 
    'Deletes Blank Rows
'    For x = .Cells.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
'        If WorksheetFunction.CountA(.Rows(x)) = 0 Then
'            ActiveSheet.Rows(x).Delete
'        End If
'    Next
 
End With

Application.ScreenUpdating = True

MsgBox "Membership Analysis Complete. Hit F9 to refresh Data", vbOKOnly
    
End Sub

Answer 1

这将处理 colB

中的 headers

Dim c As Range, ws As Worksheet

Set ws = ActiveSheet

For Each c In ws.Range("B2", ws.Cells(Rows.Count, "B").End(xlUp)).Cells
    If c.Font.Bold Then
        c.Offset(1, -1).Resize(2, 1).Value = c.Value 'copy over
        c.ClearContents                              'clear
    End If
Next c

VBA 用于格式化工作表数据的宏以创建 table

VBA macro to Format Worksheet Data to create table

excel

vba