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

Answer 2

您需要一个Find / FindNext循环，该循环将在第一个工作表中找到所有X值。找到找到的单元格之后，可以使用该单元格的行和列来标识位置和项目。

Option Explicit

Sub Macro1()
    Dim addr As String, loc As String, pro As String
    Dim ws2 As Worksheet, fnd As Range

    Set ws2 = Worksheets("sheet2")

    With Worksheets("sheet1")
        Set fnd = .Cells.Find(What:="x", after:=.Cells(1, 1), _
                              LookIn:=xlFormulas, LookAt:=xlWhole, _
                              SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                              MatchCase:=False, SearchFormat:=False)
        If Not fnd Is Nothing Then
            addr = fnd.Address(0, 0)
            Do
                loc = .Cells(fnd.Row, "A").Value
                pro = .Cells(1, fnd.Column).Value
                With ws2
                    .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) = loc
                    .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 1) = pro
                End With
                Set fnd = .Cells.FindNext(after:=fnd)
            Loop Until addr = fnd.Address(0, 0)
        End If
    End With

End Sub

根据单元格值复制数据

2 个答案: