2016-09-08 119 views
-11
Sub Seperate_Item_Codes_and_Descriptions() 

'Seperate the item codes and the descriptions and put them in respectively in columns D and E. 

Dim s As Long, a As Long, aVALs As Variant 

With Worksheets(1) 
    aVALs = .Range(.Cells(12, "B"), .Cells(.Rows.Count, "B").End(xlUp)).Value2 
    ReDim Preserve aVALs(LBound(aVALs, 1) To UBound(aVALs, 1), 1 To 2) 
    For a = LBound(aVALs, 1) To UBound(aVALs, 1) 
     s = InStr(1, aVALs(a, 1), Chr(32)) 
     aVALs(a, 2) = Mid(aVALs(a, 1), s + 1) 
     aVALs(a, 1) = Left(aVALs(a, 1), s - 1) 
    Next a 
    .Cells(12, "D").Resize(UBound(aVALs, 1), UBound(aVALs, 2)) = aVALs 
End With 

End Sub 
+6

至於你'sub'註解中提到的'獨立的項目代碼和描述,並把它們分別列d和E'。 – Smartis

回答

5

有點懶...只是閱讀代碼:

'//Procedure name. 
Sub Seperate_Item_Codes_and_Descriptions() 

'//A comment. 
'Seperate the item codes and the descriptions and put them in respectively in columns D and E. 

'//Setting up the variables. 
Dim s As Long, a As Long, aVALs As Variant 

'//Everything between this statement and End With that starts with a '.' will apply to the 
'//first worksheet in the workbook (if you rearrange the order of sheets it will still look 
'//at the tab that appears first in the workbook). 
With Worksheets(1) 

    'Get all values in the range B12 to last row containing data in column B and place in an array. 
    'Value2 is the same as Value except it doesn't use Currency or Date formats. 
    'https://support.microsoft.com/en-us/kb/182812 
    'The array will be: aVALS(1 to rownum,1 to 1) 
    'Use aVALS(1,1) for first value, aVALS(2,1) for second value. 
    'NB: If the last row is higher up than row 12 you'll get unexpected results. 
    aVALs = .Range(.Cells(12, "B"), .Cells(.Rows.Count, "B").End(xlUp)).Value2 

    'Update the last dimension of the array, while keeping the original values so its: aVALS(1 to rownum, 1 to 2) 
    'Use aVALS(1,1) is first value, aVALS(1,2) is empty, aVALS(2,1) is second value... 
    ReDim Preserve aVALs(LBound(aVALs, 1) To UBound(aVALs, 1), 1 To 2) 

    'Step through the first dimension of the array (the 1 to rownum bit). 
    For a = LBound(aVALs, 1) To UBound(aVALs, 1) 

     'Find the location of the first space in the element of the dimension being looked at. 
     'Chr(32) is an Ascii space... I think. 
     s = InStr(1, aVALs(a, 1), Chr(32)) 

     'Split the array by space and repopulate the array. 
     'Will now read as aVALS(1,1) = text to left of space, aVALS(1,2) = text to right of space. 
     aVALs(a, 2) = Mid(aVALs(a, 1), s + 1) 
     aVALs(a, 1) = Left(aVALs(a, 1), s - 1) 
    Next a 

    'Paste the array of split text back into the first worksheet in column D & E. 
    .Cells(12, "D").Resize(UBound(aVALs, 1), UBound(aVALs, 2)) = aVALs 
End With 

End Sub 
相關問題