[已解决]请大家帮忙解决 着急案件

manzhenyu789

如何将表Sheet1中的F列的内容 （F10开始往下所有）证明是否包含于表購入先リストA列的内容里（A2到A42），如果包含在里面 ，则不做改变正常显示，如果不包含于里面 则在不包含的表格里背景显示红色。请大家帮忙。很着急。

最佳答案

月排行榜 / 总排行榜

chart888

2017-6-7 14:39

manzhenyu789 发表于 2017-6-7 14:31
您好非常感谢您的回复真的好厉害。还有一个要求其实是我自己没有表达清楚的。
如果这里面出现空白的则不 ...

1. Private Sub CommandButton1_Click()
   
2. 
   
3. Dim arr, brr
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. arr = Worksheets("購入先リスト").[A2].CurrentRegion
   
6.     For i = 2 To UBound(arr)
   
7.         d(arr(i, 1)) = ""
   
8.     Next
   
9. brr = Worksheets("sheet1").Range("F10:F" & Worksheets("sheet1").Cells(Rows.Count, 6).End(3).Row)
   
10.     For i = 1 To UBound(brr)
    
11.         If brr(i, 1) <> "" Then
    
12.             If d.exists(brr(i, 1)) Then
    
13.                 i = i
    
14.             Else
    
15.                 Worksheets("sheet1").Cells(i + 9, 6).Interior.ColorIndex = 6
    
16.             End If
    
17.         End If
    
18.     Next
    
19. End Sub

复制代码

跳转到最佳答案楼层

苏子龙

用条件格式可以做，但是你用的是数据有效性，应该不会出现此种情况！

chart888

1. Private Sub CommandButton1_Click()
   
2. 
   
3. Dim arr, brr
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. arr = Worksheets("購入先リスト").[A2].CurrentRegion
   
6.     For i = 2 To UBound(arr)
   
7.         d(arr(i, 1)) = ""
   
8.     Next
   
9. brr = Worksheets("sheet1").Range("F10:F" & Worksheets("sheet1").Cells(Rows.Count, 6).End(3).Row)
   
10.     For i = 1 To UBound(brr)
    
11.         If d.exists(brr(i, 1)) Then
    
12.             i = i
    
13.         Else
    
14.             Worksheets("sheet1").Cells(i + 9, 6).Interior.ColorIndex = 6
    
15.         End If
    
16.     Next
    
17.    
    
18. End Sub

复制代码

manzhenyu789

chart888 发表于 2017-6-7 14:13

您好非常感谢您的回复真的好厉害。还有一个要求其实是我自己没有表达清楚的。
如果这里面出现空白的则不需要处理，購入先里面如果没写入的则不需要处理。
可以帮忙修改一下吗？

chart888

manzhenyu789 发表于 2017-6-7 14:31
您好非常感谢您的回复真的好厉害。还有一个要求其实是我自己没有表达清楚的。
如果这里面出现空白的则不 ...

1. Private Sub CommandButton1_Click()
   
2. 
   
3. Dim arr, brr
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. arr = Worksheets("購入先リスト").[A2].CurrentRegion
   
6.     For i = 2 To UBound(arr)
   
7.         d(arr(i, 1)) = ""
   
8.     Next
   
9. brr = Worksheets("sheet1").Range("F10:F" & Worksheets("sheet1").Cells(Rows.Count, 6).End(3).Row)
   
10.     For i = 1 To UBound(brr)
    
11.         If brr(i, 1) <> "" Then
    
12.             If d.exists(brr(i, 1)) Then
    
13.                 i = i
    
14.             Else
    
15.                 Worksheets("sheet1").Cells(i + 9, 6).Interior.ColorIndex = 6
    
16.             End If
    
17.         End If
    
18.     Next
    
19. End Sub

复制代码

manzhenyu789

chart888 发表于 2017-6-7 14:39

这个太厉害了。真的非常感谢。
我看的傻眼了，谢谢。
我又发了一个帖子可以抽出一下您的时间帮我看一下吗？谢谢

chart888

manzhenyu789 发表于 2017-6-7 15:00
这个太厉害了。真的非常感谢。
我看的傻眼了，谢谢。
我又发了一个帖子可以抽出一下您的时间帮我看一下 ...

在哪里