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

[µo°Ý] ¦X¨Ö2­ÓSHEET¤ÎSORT

[µo°Ý] ¦X¨Ö2­ÓSHEET¤ÎSORT

ºô¤W§ä¨ì¦X¨ÖSHEETªºµ{¦¡,¤@ª½¥d¦bSORTªº³¡¥÷,
¥i§_½Ð¤j¤j¬Ý¤@¤U­þùØ¥X¿ù¤F.

¥t¥~,­Y§Ú¦X¨Öªº2­ÓÀɮצb¦X¨ÖªºSHEET(sheet1)¤¤,²Ä¤@Äæ¥[¤JÀɮצWºÙ,À³¸Ó¦p¦ó§ï....

mergertosheet.zip (92.75 KB)

Anny

¦^´_ 1# anny8888
¸Õ¸Õ¬Ý
  1. Option Explicit
  2. Private Sub cmdMerge_Click()
  3.     Dim objsheet As Worksheet, desc As Workbook, WorkName As Workbook, Filename As String
  4.     Dim Sh As Worksheet, Used As Worksheet, Rng As Range, r As Range, i As Integer, n As Integer, j As Integer
  5.     Set WorkName = ThisWorkbook       'µ{¦¡©Ò¦bÀɮצWºÙ  'WorkName = Excel.ActiveWorkbook.Name '§@¥Î¤¤ÀɮצWºÙ
  6.     Set desc = Excel.Workbooks.Add    '¶}·sªºworkbook
  7.     i = 1
  8.     While WorkName.ActiveSheet.Range("b" & i) <> ""
  9.         Filename = WorkName.ActiveSheet.Range("b" & i) & ".xlsx"
  10.         Workbooks.Open WorkName.Path & "\" & Filename    '¶}±ÒÀÉ®×
  11.         Workbooks(Filename).ActiveSheet.Copy desc.Sheets(1)
  12.         ActiveSheet.Rows(1).Delete
  13.         ActiveSheet.Name = Windows(WorkName).ActiveSheet.Range("b" & i)
  14.         Windows(Filename).Close
  15.         i = i + 1 'Ū¨ú¤U¤@­ÓÀɮצWºÙ
  16.     Wend
  17.     Set Used = desc.Sheets("sheet1")   '*** ¶}·sªºworkbook*** Sheets("¦X¨Ö¦¨ªº¤u§@ªí")
  18.     'Application.DisplayAlerts = False  '°±¤î §R°£Sheet®É ¹w³]ªºÄµ§i
  19.     For Each Sh In Sheets
  20.         If Sh.Name <> Used.Name Then
  21.             Set Rng = Used.UsedRange(Used.UsedRange.Rows.Count, 1)(1, 1)
  22.             'sh.UsedRange.Offset(1).Copy.Rng  '½Æ»s¨Ó·½¦³¼ÐÀY
  23.            Sh.UsedRange.Copy Rng            '½Æ»s¨Ó·½¨S¦³¼ÐÀY
  24.            ' SH.Delete                        '§R°£¤w¸g½Æ»s¦nªºsheet
  25.         End If
  26.     Next
  27.     'Application.DisplayAlerts = True    '«ì´_ §R°£Sheet®É ¹w³]ªºÄµ§i
  28.     Used.UsedRange.Sort key1:=Used.Range("P2"), order1:=xlAscending, Header:=xlNo
  29.     Set Used = Sheets("sheet1")
  30.     n = Used.UsedRange.Rows.Count
  31.     MsgBox n
  32.     For j = 2 To n
  33.         If Used.Range("c" & j) <> "" And Used.Range("p" & j) = "" Then
  34.             Used.Rows(j).Clear
  35.         End If
  36.     Next
  37.     j = j + 1   '³o j = j + 1 ¦³¦ó§@¥Î  *****
  38.     MsgBox "¤w±N©Ò¦³Àɮ׶פJ¬¡­¶¤¤", , "Anny note"
  39. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 2# GBKEE

¤@ª½¥d¦b   ActiveSheet.Name = Windows(WorkName).ActiveSheet.Range("b" & i)

¥t¥~, ­Y§Ú§ï¦¨TXT FILE, ¥i¥H§ï¦¨.... ¥i¤@ª½·|¥d¦b ¶}±ÒtxtÀɮ׳¡¥÷, ÁÙ¦³TXT FILE ·|¹³ªþ¥ó¦³  " | "  "---" ­n¦p¦ó¤@¨Ö³B²z.
Option Explicit
Private Sub cmdMerge_Click()
    Dim objsheet As Worksheet, desc As Workbook, WorkName As Workbook, Filename As String
   Dim Sh As Worksheet, Used As Worksheet, Rng As Range, r As Range, i As Integer, n As Integer, j As Integer
    Set WorkName = ThisWorkbook       'µ{¦¡©Ò¦bÀɮצWºÙ  'WorkName = Excel.ActiveWorkbook.Name '§@¥Î¤¤ÀɮצWºÙ
   
   Set desc = Excel.Workbooks.Add    '¶}·sªºworkbook
    i = 1
  While WorkName.ActiveSheet.Range("b" & i) <> ""
         Filename = WorkName.ActiveSheet.Range("b" & i) & ".txt"
        '¶}±ÒtxtÀÉ®×
        Workbooks.OpenText Filename:=Excel.Windows(WorkName).Path & "\" & Filename, Origin:=950, StartRow:=8, DataType:=xlFixedWidth, FieldInfo:=Array( _
        Array(0, 1), Array(1, 1), Array(7, 1), Array(12, 1), Array(34, 1), Array(42, 1), Array(43, 1 _
        ), Array(51, 1), Array(53, 1), Array(61, 1), Array(63, 1), Array(71, 1), Array(73, 1), Array _
        (81, 1), Array(83, 1), Array(91, 1), Array(93, 1), Array(101, 1), Array(103, 1), Array(111, _
        1), Array(113, 1), Array(121, 1), Array(123, 1), Array(137, 1), Array(140, 1)), _
        TrailingMinusNumbers:=True
      
  'Workbooks.Open WorkName.Path & "\" & Filename
          Workbooks(Filename).ActiveSheet.Copy desc.Sheets(1)
        
        
         ActiveSheet.Rows(1).Delete
         ActiveSheet.Name = Windows(WorkName).ActiveSheet.Range("b" & i)

         Windows(Filename).Close
        
        i = i + 1 'Ū¨ú¤U¤@­ÓÀɮצWºÙ
    Wend
      
     Set Used = desc.Sheets("sheet1")   '*** ¶}·sªºworkbook*** Sheets("¦X¨Ö¦¨ªº¤u§@ªí")
    'Application.DisplayAlerts = False  '°±¤î §R°£Sheet®É ¹w³]ªºÄµ§i
    For Each Sh In Sheets
        If Sh.Name <> Used.Name Then
            Set Rng = Used.UsedRange(Used.UsedRange.Rows.Count, 1)(1, 1)
            'sh.UsedRange.Offset(1).Copy.Rng  '½Æ»s¨Ó·½¦³¼ÐÀY
           Sh.UsedRange.Copy Rng            '½Æ»s¨Ó·½¨S¦³¼ÐÀY
           ' SH.Delete                        '§R°£¤w¸g½Æ»s¦nªºsheet
        End If
    Next


  Used.UsedRange.Sort key1:=Used.Range("P2"), order1:=xlAscending, Header:=xlNo

n = Used.UsedRange.Rows.Count
'MsgBox n

For j = 2 To n
If Used.Range("c" & j) <> "" And Used.Range("p" & j) = "" Then
Used.Rows(j).Clear
End If
Next
j = j + 1 ' ­n±N©Ò¦³ªº¸ê®Æ½T»{¹L
   
    MsgBox "¤w±N©Ò¦³Àɮ׶פJ¬¡­¶¤¤", , "Anny note"
End Sub

test1.zip (742 Bytes)

Anny

TOP

¦^´_ 3# anny8888
    ¤@ª½¥d¦b   ActiveSheet.Name = Windows(WorkName).ActiveSheet.Range("b" & i)
  1. Workbooks(Filename).ActiveSheet.Copy desc.Sheets(1)
  2.         desc.ActiveSheet.Rows(1).Delete
  3.         desc.ActiveSheet.Name = WorkName.ActiveSheet.Range("b" & i)
  4.         Application.Windows(Filename).Close
½Æ»s¥N½X
¥t¥~, ­Y§Ú§ï¦¨TXT FILE, ¥i¥H§ï¦¨.... ¥i¤@ª½·|¥d¦b ¶}±ÒtxtÀɮ׳¡¥÷, ÁÙ¦³TXT FILE ·|¹³ªþ¥ó¦³  " | "  "---" ­n¦p¦ó¤@¨Ö³B²z.
  1. " | "  "---"   «ÜÃø³B¸Ì!!!
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

·PÁ¤À¨É°ò¦Æ[©À¸òª¾ÃÑ

TOP

        ÀR«ä¦Û¦b : ½_ÁJµ²±o¶V¹¡º¡¡A¶V·|©¹¤U««¡A¤@­Ó¤H¶V¦³¦¨´N¡A´N­n¶V¦³Á¾¨Rªº¯ÝÃÌ¡C
ªð¦^¦Cªí ¤W¤@¥DÃD