vba - 根据单元格值复制数据

Question

我有点卡住了，希望能找到一些帮助。我在 VBA 方面有一些经验，但这个特殊问题超出了我的编程知识。

我有一张包含 1000 - 1250 行数据的表格，以及可以每月更改的 20 - 60 列的任何地方。

我希望做的是查看每个单元格中的 X，当找到它时，它将在单独的选项卡上创建一个新行。该行将包含找到 X 的行中的第一个单元格和找到 X 的列的列标题。

我已经能够编写一些可以在工作表中找到 X 的东西，在另一页上创建新项目等等，但是我无法让一个脚本来完成我需要的所有事情。

这是一个数据结构的例子:

Data

预期结果:

Output

抱歉链接，我太新了，无法发布照片。

任何关于如何实现这一点的帮助、文档、提示等都将非常有帮助并且非常感谢。感谢您的关注!

安德鲁

编辑:

我整理的一些代码:

Dim uSht As String
Dim wsExists As Boolean
Dim lRow As Long
Dim lcol As Long
Dim ws As Worksheet



Sub CopyData()

'Setup Sheetnames
uSht = "UPLOAD"
uTem = "TEMPLATE"

' Stop flicker
Application.ScreenUpdating = False

' Check for Upload Worksheet
WorksheetExists (uSht)

'MsgBox (wsExists)
If wsExists = False Then
' If it does not exist, create it
Call CreateSheet("UPLOAD")
End If

'Setup stuff
Dim i As Integer
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets(uTem)
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets(uSht)

lRow = Cells(Rows.Count, 1).End(xlUp).Row
lcol = Cells(1, Columns.Count).End(xlToLeft).Column

'MsgBox (lRow)
'MsgBox (lCol)

Range(Cells(lRow, lColumn)).Select


Application.ScreenUpdating = True

End Sub

Sub CreateSheet(wsName)
'Creates the uSht worksheet
With ThisWorkbook
    .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = uSht
End With
End Sub

Function WorksheetExists(wsName As String) As Boolean
'Check to see if uSht exists and return.
wsName = UCase(wsName)
For Each ws In ThisWorkbook.Sheets
    If UCase(ws.Name) = wsName Then
        wsExists = True
        Exit For
    End If
Next
WorksheetExists = wsExists
End Function

Answer 1

使用 FindAll从这里:Extracting specific cells from multiple Excel files and compile it into one Excel file
(但将 LookAt:=xlPart 更改为 LookAt:=xlWhole )

粗略的轮廓:

Dim col, c, dest As Range

Set dest = sheets("results").Range("A2")
Set col = FindAll(sheets("data").range("a1").currentregion, "X")

For each c in col
    dest.resize(1,2).value = array(c.entirerow.cells(1).value, _
                                   c.entirecolumn.cells(1).value)
    set dest = dest.offset(1, 0)
next