Code: Select all
Option Explicit
Sub Macro1()
Application.ScreenUpdating = False
Application.DisplayFullScreen = False
Application.DisplayAlerts = False
ChDir "D:\UC_TXT"
Dim varFilename As Variant
varFilename = Application.GetOpenFilename("Text Files (*.txt), UC7*.txt")
If varFilename <> False Then
Workbooks.OpenText Filename:="D:\UC_TXT\" & varFilename, Origin:=874, StartRow _
:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=True, Comma:=False, _
Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array( _
3, 1), Array(4, 4), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 4), Array(10 _
, 4), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), _
Array(17, 1)), TrailingMinusNumbers:=True
Application.DisplayAlerts = False
'à»ÅÕ蹪×èÍ Sheet
Sheets("UC7600").Name = "UC7-" & mid(right(varFilename,7),1,3)
ActiveWorkbook.SaveAs Filename:="D:\UC_TXT\UC7-" & mid(right(varFilename,7),1,3), FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
With Range("A1:W1")
'Range("A1").Select
'ActiveCell.FormulaR1C1 = "PID"
'Range("B1").Select
'ActiveCell.FormulaR1C1 = "¤Ó¹Ó"
'Range("C1").Select
'ActiveCell.FormulaR1C1 = "ª×èÍ"
'Range("D1").Select
'ActiveCell.FormulaR1C1 = "¹ÒÁÊ¡ØÅ"
'Range("E1").Select
'ActiveCell.FormulaR1C1 = "Çѹà¡Ô´"
'Range("F1").Select
'ActiveCell.FormulaR1C1 = "à¾È"
'Range("G1").Select
'ActiveCell.FormulaR1C1 = "ÃËÑÊ·ÕèÍÂÙè"
'Range("H1").Select
'ActiveCell.FormulaR1C1 = "ÊÔ·¸Ôì"
'Range("I1").Select
'ActiveCell.FormulaR1C1 = "ÇѹàÃÔèÁ"
'Range("J1").Select
'ActiveCell.FormulaR1C1 = "ÇѹËÁ´"
'Range("K1").Select
'ActiveCell.FormulaR1C1 = "þËÅÑ¡"
'Range("L1").Select
'ActiveCell.FormulaR1C1 = "þÃͧ"
'Range("M1").Select
'ActiveCell.FormulaR1C1 = "ÊÔ·¸ÔìÂèÍÂ"
'Range("N1").Select
'ActiveCell.FormulaR1C1 = "¨Ç"
'Range("O1").Select
'ActiveCell.FormulaR1C1 = "àÅ¢ºÑµÃ"
'Range("P1").Select
'ActiveCell.FormulaR1C1 = "ÍÒÂØ"
'Range("Q1").Select
'ActiveCell.FormulaR1C1 = "þËÅÑ¡2"
'Range("R1").Select
'ActiveCell.FormulaR1C1 = "y"
'Range("S1").Select
'ActiveCell.FormulaR1C1 = "m"
'Range("T1").Select
'ActiveCell.FormulaR1C1 = "d"
'Range("U1").Select
'ActiveCell.FormulaR1C1 = "dmy"
'Range("V1").Select
'ActiveCell.FormulaR1C1 = "dmy543"
'Range("W1").Select
'ActiveCell.FormulaR1C1 = "9/30/2013"
'Range("A:A,O:O").Select
'Selection.NumberFormat = "0"
'Range("A1:W1").Select
'With Selection
'.HorizontalAlignment = xlCenter
'.VerticalAlignment = xlBottom
'.WrapText = False
'.Orientation = 0
'.AddIndent = False
'.IndentLevel = 0
'.ShrinkToFit = False
'.ReadingOrder = xlContext
'.MergeCells = False
'End With
.Value = Array("PID", "¤Ó¹Ó", "ª×èÍ", "¹ÒÁÊ¡ØÅ", "Çѹà´×͹»Õà¡Ô´", "à¾È", "ÃËÑÊ·ÕèÍÂÙè", "ÊÔ·¸Ôì", "ÇѹàÃÔèÁ", "ÇѹËÁ´", "þËÅÑ¡", "þÃͧ", "ÊÔ·¸ÔìÂèÍÂ", "ÊÔ·¸ÔìÂèÍÂ", "¨Ç", _
"àÅ¢ºÑµÃ", "ÍÒÂØ", "þËÅÑ¡2", "y", "m", "d", "dmy", "dmy543", "9/30/2013")
.HorizontalAlignment = xlCenter
With .Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
End With
End With
'àÅ×Í¡á¶ÇÊØ´·éÒÂ
'á¡»Õà¡Ô´
'Range("Q1").Select
'Range([R2], [Q1048576].End(xlUp).Offset(0, 1)).Select
'Selection.FormulaR1C1 = "=LEFT(RC[-13],4)"
Range([R2], [Q1048576].End(xlUp).Offset(0, 1)).FormulaR1C1 = "=LEFT(RC[-13],4)"
'á¡à´×͹à¡Ô´
'Range("R1").Select
'Range([S2], [R1048576].End(xlUp).Offset(0, 1)).Select
'Selection.FormulaR1C1 = "=MID(RC[-14],5,2)"
Range([S2], [R1048576].End(xlUp).Offset(0, 1)).FormulaR1C1 = "=MID(RC[-14],5,2)"
'á¡Çѹà¡Ô´
'Range("S1").Select
'Range([T2], [S1048576].End(xlUp).Offset(0, 1)).Select
'Selection.FormulaR1C1 = "=RIGHT(RC[-15],2)"
Range([T2], [S1048576].End(xlUp).Offset(0, 1)).FormulaR1C1 = "=RIGHT(RC[-15],2)"
Dim bytRound As Byte, lngLastRowNum As Long, strReplaceText As Variant
Columns("T:T").Select
strReplaceText = Array("07", "1")
For bytRound = LBound(strReplaceText) To LBound(strReplaceText)
lngLastRowNum = Cells(1048576, 19 + bytRound).End(xlUp).Row
'Selection.Replace What:="00", Replacement:="1", LookAt:=xlPart, _
'SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
'ReplaceFormat:=False
'á·¹¤èÒ 00
Range(Cells(2, 19 + bytRound), Cells(lngLastRowNum, 19 + bytRound)).Replace What:="00", Replacement:=strReplaceText(bytRound), LookAt:=xlPart, _
SearchOrder:=xlByRows
Next bytRound
'Range("S2").Activate
'Selection.Replace What:="00", Replacement:="07", LookAt:=xlPart, _
'SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
'ReplaceFormat:=False
'Range([U2], [T1048576].End(xlUp).Offset(0, 1)).Select
'Selection.FormulaR1C1 = "=RC[-1]&""/""&RC[-2]&""/""&RC[-3]"
'Range([U2], [U1048576].End(xlUp).Offset(0, 0)).Select
'Selection.Copy
'Range("U2").Select
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
':=False, Transpose:=False
Range([U2], [T1048576].End(xlUp).Offset(0, 1)).FormulaR1C1 = "=RC[-1]&""/""&RC[-2]&""/""&RC[-3]"
Range([U2], [U1048576].End(xlUp).Offset(0, 0)).Copy
Range("U2").PasteSpecial Paste:=xlPasteValues
'Range([U2], [T1048576].End(xlUp).Offset(0, 1)).Select
'Selection.Replace What:="00/00/", Replacement:="01/07/", LookAt:=xlPart, _
'SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
'ReplaceFormat:=False
'Selection.Replace What:="00/", Replacement:="01/", LookAt:=xlPart, _
'SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
'ReplaceFormat:=False
Dim strFindText As Variant
strFindText = Array("00/00/", "00/")
strReplaceText = Array("01/07", "01/")
For bytRound = LBound(strFindText) To UBound(strFindText)
' Range([U2], [T1048576].End(xlUp).Offset(0, 1)).Select
' Selection.Replace What:="00/00/", Replacement:="01/07/", LookAt:=xlPart, _
' SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
' ReplaceFormat:=False
' Selection.Replace What:="00/", Replacement:="01/", LookAt:=xlPart, _
' SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
' ReplaceFormat:=False
Range([U2], [T1048576].End(xlUp).Offset(0, 1)).Replace What:=strFindText(bytRound), Replacement:=strReplaceText(bytRound), LookAt:=xlPart, _
SearchOrder:=xlByRows
Next bytRound
'Range([R2], [Q1048576].End(xlUp).Offset(0, 3)).Select
'Selection.Copy
'Range("R2").Select
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
':=False, Transpose:=False
Range([R2], [Q1048576].End(xlUp).Offset(0, 3)).Copy
Range("R2").PasteSpecial Paste:=xlPasteValues
'Range("U1").Select
'Range([V2], [U1048576].End(xlUp).Offset(0, 1)).Select
'Selection.FormulaR1C1 = "=DATE(YEAR(RC[-1])-543,MONTH(RC[-1]),DAY(RC[-1]))"
'Range("V1").Select
'Range([W2], [V1048576].End(xlUp).Offset(0, 1)).Select
'Selection.FormulaR1C1 = _
'"=DATEDIF(RC[-1],R1C23,""Y"")&"" »Õ ""&DATEDIF(RC[-1],R1C23,""YM"")&"" à´×͹ ""&DATEDIF(RC[-1],R1C23+1,""MD"")&"" Çѹ"""
Range([V2], [U1048576].End(xlUp).Offset(0, 1)).FormulaR1C1 = "=DATE(YEAR(RC[-1])-543,MONTH(RC[-1]),DAY(RC[-1]))"
Range([W2], [V1048576].End(xlUp).Offset(0, 1)).FormulaR1C1 = _
"=DATEDIF(RC[-1],R1C23,""Y"")&"" »Õ ""&DATEDIF(RC[-1],R1C23,""YM"")&"" à´×͹ ""&DATEDIF(RC[-1],R1C23+1,""MD"")&"" Çѹ"""
'Range("A1:W1").Select
'á»Å§ÃËÑÊ˹èǺÃÔ¡ÒÃ
'Range([L2], [K1048576].End(xlUp).Offset(0, 1)).Select
'Selection.NumberFormat = "00000"
Range([L2], [K1048576].End(xlUp).Offset(0, 1)).NumberFormat = "00000"
'á·¹¤èÒ¤Ó¹Ó à¾È
strFindText = Array("1", "3", "2", "4", "5")
strReplaceText = Array("¹ÒÂ", "¹ÒÂ", "¹.Ê", "¹.Ê.", "¹Ò§")
'Range([B2], [A1048576].End(xlUp).Offset(0, 1)).Select
For bytRound = LBound(strFindText) To UBound(strReplaceText)
'Selection.Replace What:="1", Replacement:="¹ÒÂ", LookAt:=xlPart, _
'SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
'ReplaceFormat:=False
'Selection.Replace What:="3", Replacement:="¹ÒÂ", LookAt:=xlPart, _
'SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
'ReplaceFormat:=False
'Selection.Replace What:="2", Replacement:="¹.Ê.", LookAt:=xlPart, _
'SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
'ReplaceFormat:=False
'Selection.Replace What:="4", Replacement:="¹.Ê.", LookAt:=xlPart, _
'SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
'ReplaceFormat:=False
'Selection.Replace What:="5", Replacement:="¹Ò§", LookAt:=xlPart, _
'SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
'ReplaceFormat:=False
'Range("E1").Select
'Range([F2], [E1048576].End(xlUp).Offset(0, 1)).Select
'Selection.Replace What:="1", Replacement:="ªÒÂ", LookAt:=xlPart, _
'SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
'ReplaceFormat:=False
'Selection.Replace What:="2", Replacement:="ËÔ§", LookAt:=xlPart, _
'SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
'ReplaceFormat:=False
Range([B2], [A1048576].End(xlUp).Offset(0, 1)).Replace What:=strFindText(bytRound), Replacement:=strReplaceText(bytRound), LookAt:=xlPart, _
SearchOrder:=xlByRows
Next bytRound
Cells.Select
ActiveWorkbook.Worksheets("UC7600").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("UC7600").Sort.SortFields.Add Key:=Range( _
"V2:V184608"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("UC7600").Sort.SortFields.Add Key:=Range( _
"K2:K184608"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("UC7600").Sort.SortFields.Add Key:=Range( _
"L2:L184608"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("UC7600").Sort.SortFields.Add Key:=Range( _
"C2:C184608"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("UC7600").Sort.SortFields.Add Key:=Range( _
"G2:G184608"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("UC7600").Sort
.SetRange Range("A1:W184608")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Columns("A:W").Select
'Columns("A:W").EntireColumn.AutoFit
Columns("A:W").EntireColumn.AutoFit
ActiveWorkbook.Save
MsgBox "â»Ãá¡ÃÁàÃÕ§ÍÒÂØãËéàº×éͧµé¹áÅéÇ" & vbCrLf & _
"¡ÃسÒá¡éä¢ Error ¢Í§Çѹà¡Ô´ 㹤ÍÅÑÁ¹ì U Ẻ manual ¡è͹¨Ñ´àÃÕ§ÅӴѺµÒÁÍÒÂØãËÁèÍÕ¡¤ÃÑé§ !!!", vbInformation + vbOKOnly, "¡ÒùÓà¢éÒ¢éÍÁÙÅÊÓàÃç¨"
End If
End Sub
เมื่อต้องการกรอกข้อมูลลงในบรรทัดเดียวกัน แต่ต่างเซลล์กันให้ใช้ฟังก์ชัน Array เข้าช่วย
snasui.com ยินดีต้อนรับ 
สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ 
โปรดทราบ 
