求按a12里的数,把a2到a10相符合的数留下来

王拥军

求按a12里的数,把a2到a10相符合的数留下来.rar (6.37 KB, 下载次数: 10)

2018-7-30 12:07 上传

点击文件名下载附件

jnsxmt

a12里的数,把a2到a10相符合 ...

super6675

我只会写外壳，先分列，然后里面数据判断还不会0.0

Sub 数据处理()
   
    Dim a As Integer
    Dim i As Integer
    Dim b As Integer
    For b = 1 To 9
        For i = 1 To 256
            Cells(b, i).Select
            Selection.Value = a
            If a > 0 Then （这边要改）
                Selection.Delete
            End If
        Next
    Next
        
End Sub

super6675

程序有问题，不知道如何表示3是不是在（3,4,5,6,7）里面 求高人指点

Public Sub 数据处理()

    ThisWorkbook.Sheets("Sheet2").Activate
    Dim a As Integer
    Dim i As Integer
    Dim b As Integer
    Dim c As Integer '百位
    Dim d As Integer '十位
    Dim e As Integer '各位
    Dim f As Integer '最大的数
    Dim g As Integer '最小的数
    Dim x As Integer
    Dim y As Boolean
    Dim arr
    Dim m
   
    For b = 1 To 9
        For i = 1 To 256
            Cells(1, i).Select
            a = Selection.Value
            c = Int(a / 100)
            d = Int((a - c * 100) / 10)
            e = a - c * 100 - d * 10
            arr = Array(c, d, e)
            m = Array(3, 4, 5, 6, 7)
            f = WorksheetFunction.Max(arr)
            g = WorksheetFunction.Min(arr)
            n = f - g
            x = WorksheetFunction.Match(n, m, 0)
            y = VBA.IsEmpty(x)
            If y Then
                Selection.Value = 0
            End If
        Next
    Next
        
End Sub

lsdongjh

1. Sub Test()
   
2.     Dim arrSource As Variant, arrResult As Variant
   
3.     Dim lngRow As Long, lngCount As Long, intDiff As Integer, lngID As Long
   
4.     Dim strTemp As String, strSplit() As String, strFind As String
   
5.    
   
6.     arrSource = Sheet1.Range("A2:A10")
   
7.     arrResult = Sheet1.Range("A13:B21")
   
8.    
   
9.     strFind = Sheet1.Range("A12")
   
10.    
    
11.     For lngRow = LBound(arrSource) To UBound(arrSource)
    
12.         strTemp = arrSource(lngRow, 1)
    
13.         strTemp = Trim(strTemp)
    
14.         strSplit = Split(strTemp, " ")
    
15.         For lngID = LBound(strSplit) To UBound(strSplit)
    
16.             intDiff = GetDiff(strSplit(lngID))
    
17.             If InStr(strFind, intDiff) < 1 Then
    
18.                 strSplit(lngID) = ""
    
19.             End If
    
20.         Next
    
21.         strTemp = Join(strSplit, " ")
    
22.         Do Until InStr(strTemp, "  ") < 1
    
23.             strTemp = Replace(strTemp, "  ", " ")
    
24.         Loop
    
25.         strTemp = Trim(strTemp)
    
26.         arrResult(lngRow, 1) = strTemp
    
27.         arrResult(lngRow, 2) = UBound(Split(strTemp, " ")) + 1
    
28.     Next
    
29.    
    
30.     Sheet1.Range("A13:B21") = arrResult
    
31. End Sub
    
32. 
    
33. 
    
34. Function GetDiff(strTemp As String) As Integer
    
35.     Dim intArr() As Integer
    
36.     Dim intIndex As Integer
    
37.    
    
38.     strTemp = Trim(strTemp)
    
39.     intIndex = Len(strTemp)
    
40.     ReDim intArr(1 To intIndex) As Integer
    
41.    
    
42.     For intIndex = 1 To 3
    
43.         intArr(intIndex) = Mid(strTemp, intIndex, 1)
    
44.     Next
    
45.    
    
46.     intIndex = Application.WorksheetFunction.Max(intArr) - Application.WorksheetFunction.Min(intArr)
    
47.     GetDiff = intIndex
    
48. End Function
    

复制代码

duquancai

maker