根据sheet1中的两个值，选中sheet2中相应数值所在的行和列的交叉单元格

turbidtear · 发表于 2018-6-13 13:59

求助大神

如附件，sheet2 A列与sheet1 B列的值匹配，sheet2 第一行与sheet 1 E列的日期相匹配。然后找出相交的单元格。

例如，根据sheet1 第二行的数据，要找到在sheet2中标红的这个单元格

谢谢！

半百 · 发表于 2018-6-13 14:27

选中后要干什么？表中有3条数据记录，就是有3个符合条件的单元格，都要选中吗？如果有更多的数据呢？

zhenghui13 · 发表于 2018-6-13 14:56

请查看是否达到所需效果。

Sub TZ20180613()
Dim t
Dim arr
Dim m, n
Dim Sk$
Dim s_Return$
t = Timer
arr = Sheet1.UsedRange
With Sheet2
For m = 3 To .Cells(65536, 1).End(xlUp).Row 'Loop Row
For n = 2 To .Cells(1, 256).End(xlToLeft).Column 'Loop Column
Sk = .Cells(m, 1) & "/" & .Cells(1, n) '<-WC/Date
s_Return = Get_Str_from_Array(arr, Sk)
If s_Return = "" Then
.Cells(m, n) = ""
.Cells(m, n).Interior.ColorIndex = 0
Else
.Cells(m, n) = s_Return
.Cells(m, n).Interior.ColorIndex = 3 '<-RED
End If
Next n
Next m
End With
MsgBox (Timer - t)
End Sub
Function Get_Str_from_Array(arr, Str$)
Dim i
Dim Sk$
Dim flag As Boolean
For i = 2 To UBound(arr)
Sk = arr(i, 2) & "/" & arr(i, 5) '<-WC/Date
If Sk = Str Then
Get_Str_from_Array = arr(i, 9)
Exit Function
End If
Next i
Get_Str_from_Array = ""
End Function

复制代码

turbidtear · 发表于 2018-6-13 16:11

半百发表于 2018-6-13 14:27
选中后要干什么？表中有3条数据记录，就是有3个符合条件的单元格，都要选中吗？如果有更多的数据呢？

选中以后要根据sheet1 中E列和F列的日期差，将sheet2 第一行中相应的天数标红。对sheet2 中的每一行都要这样操作。当sheet1中数据有更新的时候，sheet2也要相应变化。

例如，sheet1第一行start date 到end date 是5.22 到5.26，那么sheet2 第一行的B3到G3都要标红。

之前有人指点了怎么做每行标红，代码如下，方法是在sheet2第三列把日期差的天数做出来，然后根据这个天数标红。我在想如果能找到起始的单元格，就可以操作了。可能还需要for循环，但我也不是很会，毕竟没学过VBA...如果您能帮忙整合到一起就太好了！

With Sheet3
.Range("A3").CurrentRegion.Interior.ColorIndex = 0
  k = .Range("A65536").End(xlUp).Row
  For l = 3 To k
      .Cells(l, 4).Resize(1, .Cells(l, 3).Value).Interior.ColorIndex = 3

next
end with

turbidtear · 发表于 2018-6-15 13:04

zhenghui13 发表于 2018-6-13 14:56
请查看是否达到所需效果。

大神您好，您这个完全实现了我的描述，而且把后面的一步也做了：将选中的单元格添加sheet1 description的内容。本来我是想自己完成后面的，然而没弄出来，麻烦再帮帮忙。

我的最终需求是，选中以后要根据sheet1 中E列和F列的日期差，将sheet2 第一行中相应的天数标红。对sheet2 中的每一行都要这样操作。当sheet1中数据有更新的时候，sheet2也要相应变化。

例如，sheet1第一行start date 到end date 是5.22 到5.26，那么sheet2 第一行的B3到G3都要标红。

如果这些标红的单元格能合并，加黑框，再添加sheet1中description的内容就完美了。

zhenghui13 · 发表于 2018-6-15 13:32

turbidtear 发表于 2018-6-15 13:04
大神您好，您这个完全实现了我的描述，而且把后面的一步也做了：将选中的单元格添加sheet1 description的 ...

我一般不建议用合并单元格。

Sub TZ20180613()
Dim t
Dim arr
Dim m, n
Dim Sk$
Dim s_Return$
Dim tmp
Dim k%
t = Timer
arr = Sheet1.UsedRange
With Sheet2
For m = 3 To .Cells(65536, 1).End(xlUp).Row 'Loop Row
For n = 2 To .Cells(1, 256).End(xlToLeft).Column 'Loop Column
Sk = .Cells(m, 1) & "/" & .Cells(1, n) '<-WC/Date
s_Return = Get_Str_from_Array(arr, Sk)
If Len(s_Return) > 1 Then
tmp = Split(s_Return, "|")
.Cells(m, n) = tmp(0)
For k = 0 To Int(tmp(1))
.Cells(m, n + k).Interior.ColorIndex = 3 '<-RED
Next k
Exit For
Else
.Cells(m, n) = ""
.Cells(m, n).Interior.ColorIndex = 0
End If
Next n
Next m
End With
MsgBox (Timer - t)
End Sub
Function Get_Str_from_Array(arr, Str$) As String
Dim i
Dim Sk$
Dim i_Dur
For i = 2 To UBound(arr)
Sk = arr(i, 2) & "/" & arr(i, 5) '<-WC/Date
If Sk = Str Then
i_Dur = arr(i, 6) - arr(i, 5)
Get_Str_from_Array = arr(i, 9) & "|" & i_Dur
Exit Function
End If
Next i
Get_Str_from_Array = ""
End Function

复制代码

turbidtear · 发表于 2018-6-15 15:58

zhenghui13 发表于 2018-6-15 13:32
我一般不建议用合并单元格。

非常感谢！

turbidtear · 发表于 2018-6-19 10:58

zhenghui13 发表于 2018-6-15 13:32
我一般不建议用合并单元格。

大神您好，您的给的代码在实际操作中发现，如果添加sheet1 中的数据，程序没有问题。但如果更改sheet1 中已有的数据并再次运行宏，之前的sheet2 中运行的结果结果却仍保留。请问这个有办法解决吗？最好是无论添加或者更改sheet1 中的数据，sheet2运行的结果都能刷新。

另外，如果不合并单元格，可以有办法把相邻两个日期段标红的单元格分别标成不同的颜色吗？如果都是红色，不好区分每一项task所占的时间。

多谢了！

zhenghui13 · 发表于 2018-6-19 13:29

turbidtear 发表于 2018-6-19 10:58
大神您好，您的给的代码在实际操作中发现，如果添加sheet1 中的数据，程序没有问题。但如果更改sheet1 中 ...

上面一个问题，如果需要手工选择区域并清除内容，可以在with Sheet2下面加入以下语句:
Set rng = Application.InputBox("Select.Range", "Selection", Type:=8)
rng.Clear

第二个问题，不是很明白什么意思。我看下来一行就是一个task,没有什么太大问题。

turbidtear · 发表于 2018-6-20 09:59

zhenghui13 发表于 2018-6-19 13:29
上面一个问题，如果需要手工选择区域并清除内容，可以在with Sheet2下面加入以下语句:
Set rng = Applic ...

关于第二个问题，如果同一个workcenter下有两个任务是相衔接的，就不太好分辨。最好是像附件打勾的第二行那样，通过颜色区分开。
谢谢！

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

[求助] 根据sheet1中的两个值，选中sheet2中相应数值所在的行和列的交叉单元格

评分