excel - VBA代码匹配多列中的值,然后将相应的值转置到单独的列
问题描述
我的 VBA 技能充其量只是新手,我不知道如何有效地解决这个问题。
目标:匹配案例 ID #和客户名称(一个案例 ID # 可以有多个客户),如果它们都匹配,则根据问题 #(问题列)从响应列中提取 Q 响应
我有 2 个源文件和一个目标文件。我设法将所有必要的数据从源文件 1(SF1)提取到目标文件(DF)。
我需要将数据从 SF2 提取到 DF。
SF2 数据的结构如下:
Case ID Client Name Question # Response
10095 ABS 0.1 50
10095 ABS 0.2 100
10095 ABS 0.3 0
10095 ZZZ 0.1 0
10095 ZZZ 0.2 40
10095 ZZZ 0.3 99
29999 OVFLW 0.1 100
DF 的结构/看起来如下所示:
CASE ID Client Name 0.1 0.2 0.3
10095 ABS 50 100 0
10095 ZZZ 0 40 99
29999 OVFLW 100
我拥有的代码能够获得上述所有内容,但除了CASE ID之外,不能解释额外的变量是要匹配的客户端名称。欢迎任何想法/建议。
先感谢您。下面的代码:
选项显式
Public Sub GrabKpiData3()
Dim sht As Worksheet, sht2 As Worksheet
Dim i As Long, k As Long
Dim lastrow As Long, lastcol, foundrow As Long, foundcol As Long
Dim macrobook As Workbook
Dim macrosheet As Worksheet
Set macrobook = ThisWorkbook
Set macrosheet = macrobook.Worksheets("Macro")
'source
Set sht = Workbooks("SourceFile2.csv").Worksheets("SF2")
'destination
Set sht2 = Workbooks("MacroFile.xlsm").Worksheets("Data")
lastrow = sht.Cells(sht.Rows.Count, 1).End(xlUp).Row
k = 2
For i = 2 To lastrow
If sht2.Cells(k, 1).Value = sht.Cells(i, 1).Value Then
'the below 2 rows grab different date values present within SF2. This would change based on match criteria requiring Case ID + Client name
sht2.Cells(k, 16).Value = sht.Cells(i, 2).Value
sht2.Cells(k, 17).Value = sht.Cells(i, 3).Value
lastcol = sht2.Cells(1, sht2.Columns.Count).End(xlToLeft).Column
'captures responses for 0.1
sht2.Cells(k, 18).Value = sht.Cells(i, 6).Value
i = i + 1
'captures responses for 0.2
sht2.Cells(k, 19).Value = sht.Cells(i, 6).Value
i = i + 1
'captures responses for 0.3
sht2.Cells(k, 20).Value = sht.Cells(i, 6).Value
i = i + 1
sht2.Cells(k, 21).Value = sht.Cells(i, 6).Value
i = i + 1
sht2.Cells(k, 22).Value = sht.Cells(i, 6).Value
k = k + 1
Else
On Error Resume Next
End If
Next i
End Sub
解决方案
这是一个正常的 VBA 解决方案,应该可以工作(虽然 SQL 很好,但您可能会遇到一些兼容性/版本问题)...
Set sht = Worksheets("SF2")
Set sht2 = Worksheets("DF")
SrcLastRow = sht.Cells(sht.Rows.Count, 1).End(xlUp).Row
DestLastRow = sht2.Cells(sht2.Rows.Count, 1).End(xlUp).Row
For i = 2 To SrcLastRow
' Find the row with a matching Case ID/Client Name
For k = 2 To DestLastRow
If sht2.Cells(k, 1).Value = sht.Cells(i, 1).Value And _
sht2.Cells(k, 2).Value = sht.Cells(i, 2).Value Then _
Exit For
Next
' Updated - Forgot to add new records...
If k > DestLastRow Then ' it's a new CaseID/Client Name, so add it
sht2.Cells(k, 1).Value = sht.Cells(i, 1).Value
sht2.Cells(k, 2).Value = sht.Cells(i, 2).Value
DestLastRow = DestLastRow + 1
End If
q = 3 ' Starting column for Questions, look for a matching question/header (or blank)
Do Until sht2.Cells(1, q).Value = sht.Cells(i, 3).Value Or sht2.Cells(1, q).Value = vbNullString
q = q + 1
Loop
' Write the header for the next question, if it doesn't exist
If sht2.Cells(1, q).Value = vbNullString Then sht2.Cells(1, q).Value = sht.Cells(i, 3).Value
' Write the Response
sht2.Cells(k, q).Value = sht.Cells(i, 4).Value
Next
更新:经过测试和修复的代码可以创建新的标头。
推荐阅读
- ios - 我可以重新分配给 SwiftUI 视图中的 var 吗?
- php - laravel 7,刀片文件找不到功能
- google-cloud-platform - 无法在 GCE 上创建 GPU 实例
- node.js - Mongoose - 获取和删除子记录
- python - 如何使用正则表达式转大写并删除除管道符号外的所有字母数字
- javascript - 如果我的 JavaScript 文件不是模块,如何使用 Chartjs 和 Date-FNS 将 motnh time aixs 翻译成另一种语言?
- android - 在加载新的声音文件之前释放 soundPool?
- frontend - 搜索工具:自动定义自己、保存响应并重新发送它们的代理服务器
- instagram - 如何在 wordpress 网站上集成订阅 instagram 按钮
- python - 用于在 Python 中调整实例属性的 EXP 系统(基于文本的 RPG)