ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] excel ¦Û°Ê¿z¿ï¨Ì·Ó¥t¥~¤@­Ó¤u§@ªíªº¤º®e

[µo°Ý] excel ¦Û°Ê¿z¿ï¨Ì·Ó¥t¥~¤@­Ó¤u§@ªíªº¤º®e

¥»©«³Ì«á¥Ñ ljuber ©ó 2016-1-21 11:18 ½s¿è

½Ð°Ý¦U¦ì¤j¤j §Ú¦³­Ó¸g±`©Êªº¤u§@

§Ú¦³¿ý»s¥¨¶°¨Ã¥B¤p¤p­×§ï ¦ý¬O¦³¤U­±´X¶µ¤£ª¾¹D­n«ç»ò­×§ï¡G

1.¥i¥H±qÀÉ®×Á`ºÞ¿ï¾Ü¤å¦rÀɮ׶פJ

2.¿z¿ï±ø¥ó¦b ³]©w¤u§@ªíªºA2:A4 (¦¹½d³ò·|ÅÜ°Ê)
  (¬O¨Ì·Ótab¤À¹j ·|¦b²Ä¤­Äæ)

3.½Æ»s§¹«á¤å¦rÀÉ®×·|¦Û°ÊÃö³¬

4.§â¿z¿ï«áªº¸ê®Æ¶K¨ì¸ê®Æ¤u§@ªí¡A¸ê®Æ·|¤@ª½©¹¤U¥[¤U¥h

(ªþ¤WÀɮס^ ½m²ß.zip (346.84 KB)

¿ý»sªº¥¨¶°¡G
Sub Macro1()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set MainSh = Workbooks("½m²ß.xlsm")
    abc = Sheets("¸ê®Æ").Range("A1").End(xlDown).Row
    Workbooks.OpenText Filename:="D:\10412-ai201.txt", Origin:=950, Tab:=True, TrailingMinusNumbers:=True
    Columns("A:G").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$G$111784").AutoFilter Field:=5, _
    Criteria1:=Array("11001", "11005", "11009"), Operator:=xlFilterValues
    Selection.Copy
    MainSh.Sheets("¸ê®Æ").Activate
    Range("A" & abc + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues
End Sub
VBA·s¤â

¦^´_ 1# ljuber
  1. Private Sub StartLoadText()
  2.     Const ColumnsNum As Long = 7
  3.     Dim strFind   As String
  4.     Dim Value()   As Variant, valRow() As String
  5.     Dim StartRow  As Long
  6.     Dim textFile  As String
  7.     Dim bytArr()  As Byte
  8.     Dim I As Long, J As Long
  9.     Dim TextFileName As Variant
  10.     Dim RegExp    As Object
  11.     Dim Matchs    As Object
  12.    
  13.     On Error Resume Next
  14.     Set RegExp = CreateObject("VBScript.RegExp")
  15.     If RegExp Is Nothing Then Exit Sub
  16.     TextFileName = Application.GetOpenFilename(FileFilter:="Text File,*.TXT", FilterIndex:=1, Title:="Please Change a Text File")
  17.     StartRow = Sheet2.Range("A" & Sheet2.Rows.Count).End(xlUp).Row
  18.     If StartRow < 2 Then Exit Sub
  19.     If VarType(TextFileName) = vbString Then
  20.         I = FileLen(TextFileName)
  21.         If I < 1 Then Exit Sub
  22.         ReDim bytArr(0 To I - 1)
  23.         I = FreeFile
  24.         Open TextFileName For Binary As I
  25.         Get I, , bytArr()
  26.         Close I
  27.         textFile = StrConv(bytArr, vbUnicode)
  28.         Erase bytArr
  29.         With RegExp
  30.             .Global = True
  31.             .IgnoreCase = True
  32.             If StartRow > 2 Then
  33.                 .Pattern = "(\S+\t){4}((" & Join(Application.WorksheetFunction.Transpose(Sheet2.Range("A2:A" & StartRow).Value), ")|(") & "))(\t.+)*"
  34.             Else
  35.                 .Pattern = "(\S+\t){4}(" & Sheet2.Range("A2").Value & ")(\t.+)*"
  36.             End If
  37.             Set Matchs = .Execute(textFile)
  38.         End With
  39.         With Matchs
  40.             ReDim Value(0 To .Count - 1, 0 To ColumnsNum - 1)
  41.             For I = 0 To .Count
  42.                 valRow = Split(.Item(I), vbTab)
  43.                 For J = 0 To ColumnsNum - 1
  44.                   Value(I, J) = valRow(J)
  45.                 Next J
  46.             Next I
  47.         End With
  48.         Set Matchs = Nothing: Set RegExp = Nothing
  49.         StartRow = Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp).Row
  50.         StartRow = StartRow + 1
  51.         Application.ScreenUpdating = False
  52.         Sheet1.Range("A" & StartRow).Resize(I - 1, ColumnsNum).Value = Value
  53.         Application.ScreenUpdating = True
  54.     End If
  55. End Sub
½Æ»s¥N½X
¹B¦æªþ¥ó ½m²ß.zip (350.79 KB) ¤¤ªº«ö¶s¡G

20160122.png (28.23 KB)

20160122.png

¥@¬É¨º»ò¤j¡A¥i§Ú·Q¥h­þ¡H

TOP

¦^´_ 1# ljuber
¸Õ¸Õ¬Ý¡G
  1. Option Explicit

  2. Sub Ex()
  3.     Dim loc As Long, cts As Long, txtFile As String, arr() As String, sp() As String
  4.    
  5.     Application.DisplayAlerts = False
  6.     Application.ScreenUpdating = False
  7.    
  8.     txtFile = Application.GetOpenFilename("(*.txt), *.txt")
  9.     If txtFile = "" Then Exit Sub
  10.    
  11.     sp = Split(txtFile, "\")
  12.     With Workbooks("½m²ß.xlsm")
  13.         cts = .Sheets("³]©w").Range("A1").End(xlDown).Row
  14.         
  15.         ReDim Preserve arr(cts - 1)       '  °ÊºA¦a³B²z arr °}¦C±a¤J¤§°}¦C­È¡C
  16.         For loc = 2 To cts
  17.            arr(loc - 1) = .Sheets("³]©w").Range("A" & loc).Text   '
  18.         Next loc
  19.         
  20.         loc = .Sheets("¸ê®Æ").Range("A1").End(xlDown).Row
  21.         '  Workbooks.OpenText Filename:=ThisWorkbook.Path & "\10412-ai201.txt", Origin:=950, Tab:=True, TrailingMinusNumbers:=True
  22.         Workbooks.OpenText Filename:=txtFile, Origin:=950, Tab:=True, TrailingMinusNumbers:=True
  23.       
  24.         ActiveSheet.Range("A:G").AutoFilter Field:=5, _
  25.             Criteria1:=arr, Operator:=xlFilterValues
  26.             '  °ÊºA¦a³B²z Criteria1 ±a¤J¤§­È¡C
  27.             '  Criteria1:=Array("11001", "11005", "11009"), Operator:=xlFilterValues
  28.         Columns("A:G").Copy
  29.         .Sheets("¸ê®Æ").Range("A" & loc + 1).PasteSpecial Paste:=xlPasteValues
  30.         
  31.         '  Workbooks("10412-ai201.txt").Close
  32.         Workbooks(sp(UBound(sp))).Close
  33.         '  .Sheets("¸ê®Æ").Range("A" & loc + 1).Select
  34.     End With
  35. End Sub
½Æ»s¥N½X

TOP

·PÁ¦U¦ì¤j¤jªºÀ°¦£  ¾Ç²ß¤F §ÚÁÙ­n¬ã¨s¦U¦ìªºµ{¦¡½X^^
VBA·s¤â

TOP

¥t­Ó°Ñ¦Ò¡G
Sub TEST()
Dim xFile, T$, TR, xR As Range, Arr(), Brr, xL$, N&,  i&, j&
xFile = Application.GetOpenFilename("(*.txt), *.txt")
If xFile = "" Then Exit Sub
¡@
For Each xR In Range([³]©w!A2], [³]©w!A1].Cells(Rows.Count, 1).End(xlUp))
¡@¡@If xR <> "" Then T = T & "|" & xR
Next
¡@
Open xFile For Input Access Read As #1
Do Until EOF(1)
¡@¡@Line Input #1, xL
¡@¡@TR = Split(xL, vbTab)
¡@¡@If InStr(T & "|", "|" & TR(4) & "|") Then
¡@¡@¡@¡@N = N + 1: ReDim Preserve Arr(N - 1): Arr(N - 1) = TR
¡@¡@End If
Loop
Close #1
¡@
If N = 0 Then Exit Sub
ReDim Brr(N - 1, 6)
For i = 0 To N - 1
¡@¡@For j = 0 To UBound(Arr(i))
¡@¡@¡@¡@Brr(i, j) = Arr(i)(j)
¡@¡@Next
Next
¡@
Set xR = [¸ê®Æ!A1].Cells(Rows.Count, 1).End(xlUp)
If xR <> "" Then Set xR = xR(2)
xR.Resize(N, 7) = Brr
End Sub

TOP

        ÀR«ä¦Û¦b : ¤p¨Æ¤£°µ¡B¤j¨ÆÃø¦¨¡C
ªð¦^¦Cªí ¤W¤@¥DÃD