Vba 基于单元格值复制数据

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

我有一个包含1000-1250行数据的工作表，每个月可以更改20-60列

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

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

这是数据结构的一个示例：

预期结果：

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

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

安德鲁

编辑：

我编写的一些代码：

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

---

从这里使用

FindAll

： （但将

LookAt:=xlPart

更改为

LookAt:=xlother

）

大致轮廓：

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

---

您需要一个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

---

只有X一个人在牢房里？每行多个X，或者每行只有一个？你说你写了一些代码，但我没有看到任何代码。您的问题是要包括您编写的代码。单元格中只有一个X表示项目适用于某个位置。对不起，我的代码是所有单独的函数，旨在学习如何搜索数据中的值，在找到值时返回行数据等，我无法得到一个函数来完成所有的工作，所以没有太多的东西可以发布？我非常感谢你的帮助，我得到了如何工作的基本概念，但我被困在结合代码来完成正确工作的复杂性上。非常感谢你，我正在消化回答。我真的很感谢你抽出时间，谢谢你吉普和蒂姆！还回顾了这一点，这也很有帮助！再次感谢您，Jeeped的解决方案非常有效。另外，通过您的帮助和示例，我正在学习更多关于VBA的知识。谢谢你的帮助！