一个工作簿中有n个工作表,需要提取所有工作表中单元格d4,b4,b11,d11,f11,h11,j11,l11,011,p13的信息到sheet1,并且要保证数字前要加',用vba完成。
时间: 2023-09-06 08:13:54 浏览: 37
以下是示例代码,可以提取所有工作表中指定单元格的信息,并将其写入到名为 "Sheet1" 的工作表中:
```
Sub ExtractData()
Dim wb As Workbook
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range
Dim i As Integer
Dim j As Integer
Dim data As String
' 打开当前工作簿
Set wb = ThisWorkbook
' 创建名为 "Sheet1" 的工作表
Set ws = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
ws.Name = "Sheet1"
' 设置表头
ws.Range("A1") = "Sheet Name"
ws.Range("B1") = "Cell Address"
ws.Range("C1") = "Cell Value"
' 循环遍历所有工作表
For i = 1 To wb.Sheets.Count
Set ws = wb.Sheets(i)
' 遍历指定单元格
For j = 1 To 14
Select Case j
Case 1
Set rng = ws.Range("D4")
Case 2
Set rng = ws.Range("B4")
Case 3
Set rng = ws.Range("B11")
Case 4
Set rng = ws.Range("D11")
Case 5
Set rng = ws.Range("F11")
Case 6
Set rng = ws.Range("H11")
Case 7
Set rng = ws.Range("J11")
Case 8
Set rng = ws.Range("L11")
Case 9
Set rng = ws.Range("O11")
Case 10
Set rng = ws.Range("P13")
End Select
' 提取数据并保持数字格式
If IsNumeric(rng.Value) Then
data = "'" & Format(rng.Value, "0.00")
Else
data = rng.Value
End If
' 将数据写入到 "Sheet1"
ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1, 0) = ws.Name
ws.Cells(ws.Rows.Count, "B").End(xlUp).Offset(1, 0) = rng.Address
ws.Cells(ws.Rows.Count, "C").End(xlUp).Offset(1, 0) = data
Next j
Next i
End Sub
```
请将代码复制到 VBA 编辑器中并运行即可。注意修改指定单元格的信息以适应你的需求。