我有 1994 年至 2014 年的年份范圍，并且相應的公司名稱值相互對立（輸出表）。每年都有各自公司的銷售資料，我使用這個公式（如下）從 Sheet1 獲取到輸出表。
源作業表/作業表 1
輸出表
=INDEX('Sheet1'!$E$5:$Y$685,MATCH(Output!B2,'Sheet1'!$D$5:$D$685,0),MATCH(Output!A2,'Sheet1'!$E$4:$Y$4,0))
我使用了兩個匹配公式，因為我想驗證公司名稱和年份。
現在，我想檢查我從上面的等式中檢索到的值是否與源值完全匹配/真。因此，我嘗試使用此公式，但盡管第一個 IF 邏輯為真，但第二個失敗。
=IFS(Output!B2=INDEX('Sheet1'!$D$5:$D$685,MATCH(Output!B2,'Sheet1'!$D$5:$D$685,0)),"OK",C2=INDEX('Sheet1'!$E$5:$Y$685,MATCH(Output!B2,'Sheet1'!$D$5:$D$685,0),MATCH(Output!A2,'Sheet1'!$E$4:$Y$4,0)),"FINE")
我正在為手頭的整個任務尋找 VBA 代碼，以防萬一 VBA 使它更容易，因為我有巨大的資料集來執行相同的程序。
uj5u.com熱心網友回復：
VBA 轉軸
- 將代碼復制到標準模塊中，例如
Module1包含兩個作業表的作業簿。 - 仔細調整常量部分中的值。
- 兩個單元格地址均指表標題的第一個單元格。
- 你應該
PowerQuery試一試。一旦你掌握了它，將需要幾分鐘的時間。它有很多選擇。
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Unpivots a table range (has headers) to another worksheet.
' Calls: 'RefCurrentRegionBottomRight'.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub UnPivotData()
' Source
Const sName As String = "Sheet1"
Const sFirstCellAddress As String = "D4"
Const scCount As Long = 22
' Destination
Const dName As String = "Output"
Const dFirstCellAddress As String = "A1"
Dim dHeaders As Variant: dHeaders = VBA.Array("YEAR", "COMPANY", "WC01651")
' Workbook
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Write from source range to source array.
Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
Dim sfCell As Range: Set sfCell = sws.Range(sFirstCellAddress)
Dim srg As Range
Set srg = RefCurrentRegionBottomRight(sfCell).Resize(, scCount)
Dim srCount As Long: srCount = srg.Rows.Count
Dim sData As Variant: sData = srg.Value
' Size destination array.
Dim dhUpper As Long: dhUpper = UBound(dHeaders)
Dim drCount As Long: drCount = (srCount - 1) * (scCount - 1) 1
Dim dcCount As Long: dcCount = dhUpper 1 ' zero- vs one-based
Dim dData As Variant: ReDim dData(1 To drCount, 1 To dcCount)
' Write headers.
Dim dh As Long
For dh = 0 To dhUpper
dData(1, dh 1) = dHeaders(dh)
Next dh
Dim dr As Long: dr = 1 ' headers already written
Dim sr As Long
Dim sc As Long
' Write data ('body').
For sr = 2 To srCount
For sc = 2 To scCount
dr = dr 1 ' Note the 'PowerQuery' terms in parentheses:
dData(dr, 1) = sData(1, sc) ' write column labels (attributes)
dData(dr, 2) = sData(sr, 1) ' write row labels
dData(dr, 3) = sData(sr, sc) ' write values (values)
Next sc
Next sr
' Write from destination array to destination range.
Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
Dim dfCell As Range: Set dfCell = dws.Range(dFirstCellAddress)
Dim dcrg As Range
Set dcrg = dfCell.Resize(dws.Rows.Count - dfCell.Row 1, dcCount)
dcrg.ClearContents
Dim drg As Range: Set drg = dfCell.Resize(drCount, dcCount)
drg.Value = dData
MsgBox "Data transferred.", vbInformation
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Returns a reference to the range starting with a given cell
' and ending with the last cell of its Current Region.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function RefCurrentRegionBottomRight( _
ByVal FirstCellRange As Range) _
As Range
If FirstCellRange Is Nothing Then Exit Function
With FirstCellRange.Cells(1).CurrentRegion
Set RefCurrentRegionBottomRight = _
FirstCellRange.Resize(.Row .Rows.Count - FirstCellRange.Row, _
.Column .Columns.Count - FirstCellRange.Column)
End With
End Function
轉載請註明出處，本文鏈接：https://www.uj5u.com/caozuo/380742.html