[已解决]为什么没有效果呢 代码

heyunfei100_cn

粘错了

heyunfei100_cn

Sub 工序核对()
Dim i As Long
n = Cells.Find("*", , , , 1, 2).Row
l = 2
For i = 2 To n
    For j = 1 To 85
     If Sheets("Sheet1").Cells(i, 3) = Sheets("Sheet2").Cells(j, 1) Then
     Exit For
     End If
    Next j
    If j < 85 Then
    Sheets("Sheet2").Cells(j, l) = i
    l = l + 1
    End If
Next i
Sheets(2).Select
    Range("B1:AD85").Select
    Range("AD85").Activate
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.Delete Shift:=xlToLeft
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("J9").Select

End Sub

hwc2ycy

不行那是你代码的思路有问题。

hwc2ycy

你就说你要实现什么功能，说明点。

顺⑦.zì繎。

1. Sub 工序核对()
   
2. Dim i As Long
   
3. lrow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
   
4. lrow2 = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
   
5.     ar = Sheet1.Range("b2:c" & lrow)
   
6.     br = Sheet2.Range("a1:a" & lrow2)
   
7.         For i = 1 To UBound(br)
   
8.             For j = 1 To UBound(ar)
   
9.                 If br(i, 1) = ar(j, 2) Then
   
10.                     br(i, 1) = ar(j, 1)
    
11.                     GoTo 100
    
12.                 End If
    
13.             Next j
    
14.              br(i, 1) = ""
    
15. 100:
    
16.         Next i
    
17.     Sheet2.[b1].Resize(UBound(br)) = br
    
18. End Sub
    
19. 
    

复制代码

苗凱

hwc2ycy 发表于 2014-3-1 10:41
l不是变成3了嘛，说明只有一条符合要求。

需要的是在表2 写下对应的表1工艺的行号  

heyunfei100_cn

试试这个代码看：
Sub 工序核对()
Dim i As Long
n = Cells.Find("*", , , , 1, 2).Row
l = 2
For i = 2 To n
    For j = 1 To 85
     If Sheets("Sheet1").Cells(i, 3) = Sheets("Sheet2").Cells(j, 1) Then
     Exit For
     End If
    Next j
    If j < 85 Then
    Sheets("Sheet2").Cells(j, l) = i
    l = l + 1
    End If
Next i
Sheets(2).Select
    Range("B1:AD85").Select
    Range("AD85").Activate
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.Delete Shift:=xlToLeft
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("J9").Select

End Sub

顺⑦.zì繎。

1. =TEXT(MAX(IF(A1=Sheet1!$C$2:$C$31,Sheet1!$B$2:$B$31)),"0;;")

复制代码

这小题还是公式来的方便

dsmch

苗凱 发表于 2014-3-1 10:33
...........

1. Sub Macro1()
   
2. Dim arr, brr, d, i&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Sheet1.Range("a1").CurrentRegion
   
5. brr = Sheet2.Range("a1").CurrentRegion
   
6. For i = 2 To UBound(arr)
   
7.     d(arr(i, 3)) = arr(i, 2)
   
8. Next
   
9. For i = 1 To UBound(brr)
   
10.     brr(i, 1) = d(brr(i, 1))
    
11. Next
    
12. Sheet2.Range("b1").Resize(UBound(brr), 1) = brr
    
13. End Sub
    

复制代码

heyunfei100_cn

heyunfei100_cn 发表于 2014-3-1 10:44
Option Explicit                                                                      'OptionExplici ...

不好意思，粘贴错了