根据单元格值复制数据
根据单元格值复制数据
提问于 2018-08-24 07:44:59
我有点卡住了，希望能找到一些帮助。我在VBA方面有一些经验，但这个问题超出了我的编程知识。
我有一个包含1000 - 1250行数据的工作表，每月可以更改20 - 60列。
我希望做的是查看每个单元格中的X，当找到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回答 2
Stack Overflow用户
发布于 2018-08-24 08:39:45
在此处使用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)
nextStack Overflow用户
发布于 2018-08-24 08:41:05
您需要一个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页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/51995692
复制相关文章
相似问题
腾讯云开发者
