我目前在 VBA 中遇到了幾個問題。我有一個包含多行和多列的資料集。
示例是：
A B C D E F ...
1 Name Food 1 Food 2 Food 3 Food4 Food 5 ...
2 Ami Oranges Twix Pizza Grapes
3 Ben Banana Apples Eggs Coke
4 Mike Peaches Burger Coffee
5 Lea Peas Berries Cake Chips Sprite
...
我想要做的是通過一個陣列讀取該資料，以便它給我以下資訊：
Name Food 1 Food 2 Food 4 Food 5 ...
Ami Oranges Twix Pizza Grapes
對應名稱的食物，但不包括空白單元格或列。
我確實找到了一個有用的 Youtube 視頻，視頻中的代碼唯一的問題是它為每一行創建了一個新的作業表！！這是我不想要的，因為作業簿中已經有一個指定的作業表，它應該出現在其中。稍后將用作 Outlook 專案中的表格。
我從 Youtube 得到的代碼如下：
Dim CompInfo(0 To 170, 1 To 21)
Dim r As Long, c As Long
Const StartRow As Long = 1
Dim ShNew As Worksheet
For r = 0 To 170
For c = 1 To 21
CompInfo(r, c) = Cells(r StartRow, c).Value
Next c
Next r
For r = 0 To 170
Set ShNew = Worksheets.Add
ShNew.Name = CompInfo(r, 2)
'Setting the headers
ShNew.Range("A1").Value = CompInfo(0, 1)
ShNew.Range("B1").Value = CompInfo(0, 2)
ShNew.Range("C1").Value = CompInfo(0, 3)
ShNew.Range("D1").Value = CompInfo(0, 4)
ShNew.Range("E1").Value = CompInfo(0, 5)
ShNew.Range("F1").Value = CompInfo(0, 6)
ShNew.Range("G1").Value = CompInfo(0, 7)
ShNew.Range("H1").Value = CompInfo(0, 8)
ShNew.Range("I1").Value = CompInfo(0, 9)
ShNew.Range("J1").Value = CompInfo(0, 10)
ShNew.Range("K1").Value = CompInfo(0, 11)
ShNew.Range("L1").Value = CompInfo(0, 12)
ShNew.Range("M1").Value = CompInfo(0, 13)
ShNew.Range("N1").Value = CompInfo(0, 14)
ShNew.Range("O1").Value = CompInfo(0, 15)
ShNew.Range("P1").Value = CompInfo(0, 16)
ShNew.Range("Q1").Value = CompInfo(0, 17)
ShNew.Range("R1").Value = CompInfo(0, 18)
ShNew.Range("S1").Value = CompInfo(0, 19)
ShNew.Range("T1").Value = CompInfo(0, 20)
ShNew.Range("U1").Value = CompInfo(0, 21)
'Setting the accounts
ShNew.Range("A2").Value = CompInfo(r, 1)
ShNew.Range("B2").Value = CompInfo(r, 2)
ShNew.Range("C2").Value = CompInfo(r, 3)
ShNew.Range("D2").Value = CompInfo(r, 4)
ShNew.Range("E2").Value = CompInfo(r, 5)
ShNew.Range("F2").Value = CompInfo(r, 6)
ShNew.Range("G2").Value = CompInfo(r, 7)
ShNew.Range("H2").Value = CompInfo(r, 8)
ShNew.Range("I2").Value = CompInfo(r, 9)
ShNew.Range("J2").Value = CompInfo(r, 10)
ShNew.Range("K2").Value = CompInfo(r, 11)
ShNew.Range("L2").Value = CompInfo(r, 12)
ShNew.Range("M2").Value = CompInfo(r, 13)
ShNew.Range("N2").Value = CompInfo(r, 14)
ShNew.Range("O2").Value = CompInfo(r, 15)
ShNew.Range("P2").Value = CompInfo(r, 16)
ShNew.Range("Q2").Value = CompInfo(r, 17)
ShNew.Range("R2").Value = CompInfo(r, 18)
ShNew.Range("S2").Value = CompInfo(r, 19)
ShNew.Range("T2").Value = CompInfo(r, 20)
ShNew.Range("U2").Value = CompInfo(r, 21)
Next r
End Sub
現在這段代碼給出了我想要的部分內容，但如果我可以在沒有為每一行創建新作業表的情況下擁有它，那將是可能的。更不用說我還嘗試添加它不應顯示/列印那些空的單元格，即使上面的單元格已填充。
If Range("C1").Select <> "" And Range("C2").Select = "" Then
Range("C1:C2").Offset(0, 1).Select
End If
那么，我做錯了什么？如果有人可以幫助我，那就太好了:)
非常感謝你
uj5u.com熱心網友回復：
匯出到另一個作業表
Option Explicit
Sub ExportNamesAndFood()
' s - Source
Const sName As String = "Sheet1"
' d - Destination
Const dName As String = "Sheet2"
Const dFirst As String = "A2"
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
Dim srg As Range: Set srg = sws.Range("A1").CurrentRegion
Dim srCount As Long: srCount = srg.Rows.Count
If srCount < 2 Then Exit Sub ' no data or only headers
Dim cCount As Long: cCount = srg.Columns.Count
Dim drCount As Long: drCount = (srCount - 1) * 2
Dim sData As Variant: sData = srg.Value
Dim dData As Variant: ReDim dData(1 To drCount, 1 To cCount)
Dim sr As Long
Dim sc As Long
Dim dr As Long
Dim dc As Long
For sr = 2 To srCount
If Len(CStr(sData(sr, 1))) > 0 Then ' name found
' Name
dr = dr 2
dData(dr - 1, 1) = sData(1, 1)
dData(dr, 1) = sData(sr, 1)
' Food
dc = 1
For sc = 2 To cCount
If Not IsEmpty(sData(sr, sc)) Then ' food found
dc = dc 1
dData(dr - 1, dc) = sData(1, sc)
dData(dr, dc) = sData(sr, sc)
'Else ' food not found
End If
Next sc
'Else ' no name found
End If
Next sr
Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
Dim dCell As Range: Set dCell = dws.Range(dFirst)
Dim drg As Range: Set drg = dCell.Resize(dr, cCount)
drg.Value = dData
MsgBox "Data exported.", vbInformation
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/qukuanlian/372604.html