返回列表 上一主題 發帖

[發問] 派車表_撥亂轉正

回復 2# BV7BW


很用心看了,但還是不能理解實際需求,看看有無其他大師願意幫忙,謝謝。

TOP

回復 13# BV7BW


1)工作表1.當客戶只有1位時.會比對不到.因而會當機
>> 如下,請測試看看,謝謝
Sub test()
Dim Arr, i&, N%
Application.ScreenUpdating = False
[E65535:G3].ClearContents
With Sheets("工作表1")
    With .Range(.[A1], .[D65536].End(3))
        Arr = .Value
        For i = 3 To UBound(Arr)
            N = N + 1
            Arr(N, 1) = Arr(i, 1)
            Arr(N, 2) = Arr(i, 2)
            Arr(N, 3) = Mid(Arr(i, 3), 1, 2)
        Next
        If N > 0 Then
            With .Range("E3").Resize(N, 3)
                .Value = Arr
                .Sort Key1:=.Item(3), Order1:=1, Header:=2
                For i = 1 To N: .Cells(i, 3) = "A" & i: Next
            End With
        End If
    End With
End With
Application.ScreenUpdating = True
End Sub


2)工作表4.重整後.可以要在重整回.照客戶編號後2碼大小順序排列....
是這樣嗎?
Range([工作表4!A65535].End(3), [工作表4!J2]).Sort Key1:=[工作表4!B2], Header:=2

TOP

回復 16# BV7BW


請問什麼是"客戶編號後2碼"?  有範例嗎?

TOP

回復 18# BV7BW


請再試看看,謝謝
Sub tt()
Dim Arr
With Sheets("工作表4")
    With .Range(.[k1], .[a65536].End(3))
        Arr = .Value
        For i = 2 To UBound(Arr)
            If InStr(Arr(i, 2), "A") Then
                Arr(i, 11) = Int(Right(Arr(i, 2), 3))
            Else
                Arr(i, 11) = Int(Mid(Arr(i, 2), 4, 3)) & "s"
            End If
        Next
        .Value = Arr
        .Sort Key1:=.Item(11), Order1:=1, Header:=1
    End With
    .Range("k1:k" & UBound(Arr)) = ""
End With
End Sub

TOP

回復 20# BV7BW


    Sub tt2()
Dim Arr
With Sheets("工作表4")
    With .Range(.[k1], .[a65536].End(3))
        Arr = .Value    '資料裝入Arr
        For i = 2 To UBound(Arr)
            If InStr(Arr(i, 2), "A") Then   '編號有 A
                Arr(i, 11) = Int(Right(Arr(i, 2), 3))   '取最後3碼的整數,數值裝入Arr(i,11)
            Else
                Arr(i, 11) = Int(Mid(Arr(i, 2), 4, 3)) & "s"  '除了編號A以外的值,取-以後3碼整數+S,數值裝入Arr(i,11)
            End If
        Next
        .Value = Arr 'Arr值貼回excel
        .Sort Key1:=.Item(11), Order1:=1, Header:=1 '以K欄排序
    End With
    .Range("k1:k" & UBound(Arr)) = ""   '清除K欄數值
End With
End Sub

TOP

回復 20# BV7BW


註解已補上,請自行調整運用,有問題再討論,謝謝

TOP

回復 24# BV7BW

請測試看看,謝謝
Sub tt3()
Dim Arr
With Sheets("工作表4")
     With .Range(.[k1], .[a65536].End(3))
         Arr = .Value    '資料裝入Arr
         For i = 2 To UBound(Arr)
             If InStr(Arr(i, 2), "S") Then   '編號有 S
                 Arr(i, 11) = Int(Mid(Arr(i, 2), 4, 3)) & "s"  '編號S,取-以後3碼整數+S,數值裝入Arr(i,11)
             Else
                 Arr(i, 11) = Int(Right(Arr(i, 2), 3))   '除了編號S以外,取最後3碼的整數,數值裝入Arr(i,11)
             End If
         Next
         .Value = Arr 'Arr值貼回excel
         .Sort Key1:=.Item(11), Order1:=1, Header:=1 '以K欄排序
    End With
     .Range("k1:k" & UBound(Arr)) = ""   '清除K欄數值
End With
End Sub

TOP

回復 27# BV7BW

不知道是不是你要的需求,請確認看看,謝謝。
Sub tt4()
Dim Arr
With Sheets("工作表1")
      With .Range(.[k1], .[a65536].End(3))
          Arr = .Value    '資料裝入Arr
          For i = 2 To UBound(Arr)
              If InStr(Arr(i, 2), "S") Then   '編號有 S
                  Arr(i, 11) = Int(Mid(Arr(i, 2), 4, 3)) & "s"  '編號S,取-以後3碼整數+S,數值裝入Arr(i,11)
              Else
                  Arr(i, 11) = Int(Right(Arr(i, 2), 3))   '除了編號S以外,取最後3碼的整數,數值裝入Arr(i,11)
              End If
          Next
          .Value = Arr 'Arr值貼回excel
          .Sort Key1:=.Item(6), Order1:=1, _
          Key2:=.Item(11), Order1:=1, Header:=1 '以F、K欄排序

    End With
      .Range("k1:k" & UBound(Arr)) = ""   '清除K欄數值
End With
End Sub

TOP

回復 32# BV7BW

請在試看看,謝謝。

Sub 復整2()
Dim Arr
With Sheets("工作表3")
      With .Range(.[k1], .[a65536].End(3))
          Arr = .Value    '資料裝入Arr
          For i = 2 To UBound(Arr)
              If Arr(i, 2) = "" Then GoTo 99  '空白就換下一個
              If InStr(Arr(i, 2), "S") Then   '編號有 S
                  Arr(i, 11) = Int(Mid(Arr(i, 2), 4, 3)) & "s"  '編號S,取-以後3碼整數+S,數值裝入Arr(i,11)
              Else
                  Arr(i, 11) = Int(Right(Arr(i, 2), 3))   '除了編號S以外,取最後3碼的整數,數值裝入Arr(i,11)
              End If
99:       Next
          .Value = Arr 'Arr值貼回excel
          .Sort Key1:=.Item(6), Order1:=1, _
          Key2:=.Item(11), Order1:=1, Header:=1 '以F、K欄排序
    End With
      .Range("k1:k" & UBound(Arr)) = ""   '清除K欄數值
End With
End Sub

TOP

        靜思自在 : 虛空有盡.我願無窮,發願容易行願難。
返回列表 上一主題