汇总工作表内容至总表

Holiday2022 · 发表于 2024-1-30 13:37

本帖最后由 Holiday2022 于 2024-1-30 20:03 编辑

大家好，求助写个vba程序，需求和文件如下，谢谢：

1. 每个日期工作表sheet中都有2个表，分别是蔬菜表和水果表，需要将其汇总到总表中，蔬菜的部分放到sheet"蔬菜"中，水果的部分放到sheet"水果"中。
2. 有些sheet的第2个表的表头在90行，有些在93行，等等，是不同的，汇总时需要注意。
3. 将蔬菜名放在第1列，产地放在第2列，好/中/差、高/中/低分别放在第3/4/5列。
4.每个蔬菜表/水果表的行数不一样，所以在复制粘贴时不能直接复制上去。
5.不同表中，同一种蔬菜/水果的产地并不一致，比如香菜本地、香菜内蒙，两者就是不一样的。所以汇总表中的A列、B列要取所有sheet中A列+B列的唯一值。

ykcbf1100 · 发表于 2024-1-30 16:41

本帖最后由 ykcbf1100 于 2024-1-30 18:45 编辑

代码以附件为准。。。

Sub ykcbf() '//2024.1.30
fns = [{"蔬菜","水果"}]
Set d = CreateObject("Scripting.Dictionary")
Set d1 = CreateObject("Scripting.Dictionary")
Dim list As New Collection
For Each sht In Sheets
If Val(sht.Name) Then
list.Add sht.Name
With sht
fn = .Name
r1 = .UsedRange.Find("水果批发").Row
r = .Cells(Rows.Count, 1).End(3).Row
For x = 1 To UBound(fns)
If x = 1 Then arr = .Range("a1:e" & r1 - 1)
If x = 2 Then arr = .Range(.Cells(r1, 1), .Cells(r, 5))
For i = 4 To UBound(arr)
If Val(arr(i, 2)) Then
s = fns(x) & "|" & arr(i, 1) & "|" & arr(i, 5)
d1(s) = ""
For j = 2 To 4
s = fns(x) & "|" & CStr(fn) & "|" & arr(i, 1) & "|" & arr(i, 5) & "|" & arr(4, j)
d(s) = arr(i, j)
Next
End If
Next
Next
End With
End If
Next
ReDim brr(1 To 1, 1 To 100)
For Each k In list
m = m + 3
brr(1, m - 2) = CStr(k)
brr(1, m - 1) = CStr(k)
brr(1, m) = CStr(k)
Next
For x = 1 To UBound(fns)
ReDim zrr(1 To 10000, 1 To 2)
n = 0
With Sheets(fns(x))
For Each k In d1.keys
st = Split(k, "|")
If st(0) = fns(x) Then
n = n + 1
zrr(n, 1) = st(1)
zrr(n, 2) = st(2)
End If
Next
.UsedRange.Offset(3).Clear
.[c2:cq2] = ""
.Rows(2).NumberFormatLocal = "@"
.[c2:cq2] = brr
.[a4].Resize(n, 2) = zrr
arr = .UsedRange
For i = 4 To UBound(arr)
For j = 3 To UBound(arr, 2)
s = fns(x) & "|" & CStr(arr(2, j)) & "|" & arr(i, 1) & "|" & arr(i, 2) & "|" & arr(3, j)
If d.exists(s) Then
arr(i, j) = d(s)
End If
Next
Next
.Rows(2).NumberFormatLocal = "@"
.UsedRange = arr
With .UsedRange.Offset(1)
.Borders.LineStyle = 1
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
End With
Next
Set d = Nothing
MsgBox "OK！"
End Sub

复制代码

Holiday2022 · 发表于 2024-1-30 13:45

每个蔬菜表/水果表的行数不一样，所以在复制粘贴时不能直接复制上去

misterZ · 发表于 2024-1-30 13:51

=VLOOKUP($A4,INDIRECT(G$2&"!A:E"),MATCH(F$3,INDIRECT(G$2&"!A4:D4"),0),0)

复制代码

Holiday2022 · 发表于 2024-1-30 13:54

misterZ 发表于 2024-1-30 13:51

谢谢，您好，我新增了这样一条需求：不同表中，同一种蔬菜/水果的产地并不一致，比如香菜本地、香菜内蒙，两者就是不一样的。所以汇总表中的A列、B列要取所有sheet中A列+B列的唯一值。这如何处理比较好？或者说，如何提取多个表中的唯一值？

misterZ · 发表于 2024-1-30 14:15

Holiday2022 发表于 2024-1-30 13:54
谢谢，您好，我新增了这样一条需求：不同表中，同一种蔬菜/水果的产地并不一致，比如香菜本地、香菜内蒙 ...

你同一个菜还有多个产地?

Holiday2022 · 发表于 2024-1-30 14:51

misterZ 发表于 2024-1-30 14:15
你同一个菜还有多个产地?

是的，有些是本地的，有些是外地的

Holiday2022 · 发表于 2024-1-30 14:57

本帖最后由 Holiday2022 于 2024-1-30 15:36 编辑

我做了一版，但目前还不是很智能，要分两步走，第一步用vba代码去重，然后找出菜名+产地的唯一值；第二步用公式来匹配。其中第二步参考了网友“misterZ”的公式，谢谢

希望大家能帮我再优化优化

ykcbf1100 · 发表于 2024-1-30 15:13

看着比较费时，先做个标记。

lhj5286 · 发表于 2024-1-30 16:25

本帖最后由 lhj5286 于 2024-1-30 16:28 编辑

已编好，看能否满足楼主需求（注：楼主的汇总表表头有两组10.3，我已将后面那组10.3改成10.30）

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

[已解决] 汇总工作表内容至总表

评分