有偿求VBA

huoye1982 · 发表于 2019-6-20 22:28

本帖最后由 huoye1982 于 2019-6-21 18:02 编辑

求写VBA，将数据表中的A列和B列对应到操作表中去，在操作表的最后一列写入对应的名字，并且将所有行按照姓名排序，其他数据不影响，数据表只有两列菜名和姓名不变但内容可变更编辑，操作表列的长度会有变化，{{已解决，谢谢2楼}}

chxw68 · 发表于 2019-6-20 22:37

Sub test()
Dim r%, i%
Dim arr, brr
Dim wb As Workbook
Dim ws As Worksheet
Dim mypath$, myname$
Dim d As Object
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set d = CreateObject("scripting.dictionary")
mypath = ThisWorkbook.Path & ""
myname = "操作表.xlsx"
If Dir(mypath & myname) = "" Then
MsgBox mypath & myname & "不存在！"
Exit Sub
End If
Set wb = GetObject(mypath & myname)
With wb
With .Worksheets("sheet1")
r = .Cells(.Rows.Count, 1).End(xlUp).Row
arr = .Range("a2:b" & r)
End With
.Close False
End With
For i = 1 To UBound(arr)
d(arr(i, 1)) = arr(i, 2)
Next
With Worksheets("sheet1")
r = .Cells(.Rows.Count, 1).End(xlUp).Row
c = .Cells(1, .Columns.Count).End(xlToLeft).Column
arr = .Range("a2:a" & r)
ReDim brr(1 To UBound(arr), 1 To 1)
For i = 1 To UBound(arr)
If d.exists(arr(i, 1)) Then
brr(i, 1) = d(arr(i, 1))
End If
Next
.Cells(2, c + 1).Resize(UBound(brr), UBound(brr, 2)) = brr
.Range("a2").Resize(r - 1, c + 1).Sort key1:=.Cells(2, c + 1), order1:=xlAscending, Header:=xlNo
End With
Application.ScreenUpdating = True
MsgBox "数据匹配完毕！"
End Sub

复制代码

chxw68 · 发表于 2019-6-20 22:37

楼主表述反了吧？

killq · 发表于 2019-6-20 22:40

这个建议要多点money，从表述看，沟通起来肯定累

huoye1982 · 发表于 2019-6-20 22:48

chxw68 发表于 2019-6-20 22:37
楼主表述反了吧？

没反，数据表是固定的，操作表里面没有姓名栏，需要在最后一列匹配上姓名然后排序

microyip · 发表于 2019-6-21 08:01

虽然没看明白两个表是什么关系，但基本上做个字典应该可以解决问题了吧?

Lonzo丶 · 发表于 2019-6-21 08:43

chxw68 发表于 2019-6-20 22:37

楼主，这层打钱，别忘了。

chxw68 · 发表于 2019-6-21 08:46

Lonzo丶发表于 2019-6-21 08:43
楼主，这层打钱，别忘了。

呵呵，你信？

microyip · 发表于 2019-6-21 08:51

Lonzo丶发表于 2019-6-21 08:43
楼主，这层打钱，别忘了。

你的提醒固然好，但注意啊，褚老师不是为钱的哦，褚老师是个热心肠的好人哦。

Lonzo丶 · 发表于 2019-6-21 09:30

我就开个玩笑，楼上两位别当真

		自动登录	找回密码
密码			免费注册

[已解决] 有偿求VBA

评分

评分

评分