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

[µo°Ý] ·j´M¡B¤ñ¹ï¡A¦A½Æ»s¹L¨Óªº¥\¯à

[µo°Ý] ·j´M¡B¤ñ¹ï¡A¦A½Æ»s¹L¨Óªº¥\¯à

¤j®a¦n¡A§Ú¦³¤@­Ó¥\¯à·Q°µ¡A¦ý¬O·j´M¤ñ¹ï§Ú¤£·|¼g


§Ú·|¦P®É¶}¤T­ÓÀÉ®×
¤@­Ó¬O´ú¸ÕÀÉ¡A¸Ì­±¦³«ö¶s¡A³oÃä¤]·|¦C¥X©Ò­nªº·Ç«h

²Ä¤G­Ó¬O¸ê®ÆÀÉ
²Ä¤T­Ó¬O¤Ø¤oÀÉ
¦@¦PÂI¬O¾Ç¸¹
¦³ÂI¹³ACCESSªº¥DÁä

´ú¸ÕÀɤ¤ ·|µ¹  ©Ò»Ý­nªº¾Ç¸¹   ¸ò³o­Ó¾Ç¸¹©Ò­n¬d¥X¨Óªº¸ê°T
µM«á«ö¶s«ö¤U«á  µ{¦¡¥i¥H¥h·j´M¤ñ¹ï  §â­nªº¸ê®Æ¶ñ¶i¨Ó´ú¸ÕÀɤ¤


¦]¬°¦P®É¶}¦n¤T­ÓÀÉ
©Ò¥Hª½±µ©I¥s¬O¥i¥H¨ú±o¸ê®Æªº

¦ý¬O·j´M¤ñ¹ï¡A§Ú´N¤£·|¤F
¦A½Ð¦U¦ì¤j¤jÀ°¦£¡AÁÂÁÂ

EXCEL°ÝÃD.rar (30.49 KB)
«¢Åo~¤j®a¦n§r

¦^´_ 1# iceandy6150


    ©ñ¦P¤@­ÓÀɮפ¤¥i¥H¶Ü?

³o2­ÓÀɮקA°Ñ¦Ò¤@¤U¡A¸Ì­±³]±ø¥ó¦ì¸m¤£¦P¡A§A¥i¥H¦Û¤v°Ñ¦ÒVBA¬ã¨s¦p¦ó­×§ï©ñ±ø¥óªº¦ì¸m¡C


VBA - ³]¦h±ø¥ó±q¸ê®Æ®w¤¤¼´¥Xµ²ªG(±`¥Î).rar (21.76 KB)

TOP

¦^´_ 1# iceandy6150
½Ð°Ñ¦Ò
  1. Private Sub CommandButton1_Click()
  2.     Dim arr
  3.     Dim brr()
  4.     Dim d As Object
  5.     Set d = CreateObject("Scripting.Dictionary")
  6.     Application.ScreenUpdating = False
  7.     ar = Array("¸ê®Æ.xlsx", "¤Ø¤o.xlsx")
  8.     For Each book In ar
  9.         Workbooks.Open ThisWorkbook.Path & "\" & book
  10.         arr = ActiveSheet.[A1].CurrentRegion
  11.         ActiveWorkbook.Close 0
  12.         For i = 2 To UBound(arr)
  13.             For j = 2 To UBound(arr, 2)
  14.                 d(arr(i, 1) & arr(1, j)) = arr(i, j)
  15.             Next j
  16.         Next i
  17.     Next book
  18.     arr = ActiveSheet.[A1].CurrentRegion
  19.     ReDim brr(1 To UBound(arr) - 1, 1 To UBound(arr, 2) - 1)
  20.     For i = 2 To UBound(arr)
  21.         For j = 2 To UBound(arr, 2)
  22.             brr(i - 1, j - 1) = d(arr(i, 1) & arr(1, j))
  23.         Next j
  24.     Next i
  25.     [B2].Resize(UBound(brr), UBound(brr, 2)) = brr
  26.     Application.ScreenUpdating = True
  27.     Erase brr
  28.     Set d = Nothing
  29.     arr = ""
  30. End Sub
½Æ»s¥N½X
ª`·N¡G¥»µ{¦¡·|¦Û°Ê¶}±Ò¨â­Ó¸ê®ÆÀɨӤñ¹ï¡A¦]¦¹°õ¦æ«e¤£»Ý¥ý¶}±Ò¸ê®ÆÀɮסC

TOP

¦^´_ 2# jeffrey628litw


    ·PÁ±zªº¦^ÂСA¦]¬°§Úªº¸ê®Æ¬O¦b¤£¦PªºÀɮפ¤¡A©Ò¥Hµo°Ý¤~·|¨Ï¥Î¤£¦PÀÉ®×
   §Ú·|¦A¦Û¤v¸Õ¬Ý¬Ýªº¡AÁÂÁ±z
«¢Åo~¤j®a¦n§r

TOP

¦^´_ 3# Kubi


    «z~~ §A³o­ÓÁÙ¥i¥H¦Û°Ê¶}¥t¥~ªºÀɮסAµM«áÁÙ¥i¥H¦Û°ÊÃöÀÉ
   ¤Ó´Î¤F°Õ¡A³o©Û§Ú¤@©w­n¾Ç°_¨Ó
   ·PÁ±zªº¤À¨É¡A¥\¯à§¹¥þ²Å¦X§Úªº»Ý¨D
    ¦Ó¥B¤£»Ý­n¼g«Ü¦h¦æ´N·d©w¤F
    §Ú¥ú¬O°}¦C¨ºÃä´N¤£¦æ¤F....
    ¦A¦¸·PÁÂ
«¢Åo~¤j®a¦n§r

TOP

¦^´_ 5# iceandy6150
VBAªº¥i¥Î¤£¦Pªº¼gªk,¨Ó¹F¨ì¦P¤@®ÄªG
  1. Option Explicit
  2. Private Sub CommandButton1_Click()
  3.     Dim Rng() As Range, Ar(), xR As Variant, xC As Variant, i As Integer, ii As Integer
  4.     Dim xRng As Range
  5.     Application.ScreenUpdating = False
  6.     Ar = Array("´ú¸Õ.XLSM", "¤Ø¤o.XLSX", "¸ê®Æ.XLSX")
  7.     ReDim Rng(UBound(Ar))       '** Rng ­«¸m¤¸¯À»P Ar ¤@¼Ë¦h
  8.     For i = 0 To UBound(Ar)
  9.         '**Workbooks(Ar(0)).Path ** ­×§ï¬° ¤Ø¤o , ¸ê®Æ Àɮתº¥¿½T¸ê®Æ§¨¦ì¸m**
  10.         If i > 0 Then Workbooks.Open (Workbooks(Ar(0)).Path & "\" & Ar(i)) '**¶}±ÒÀÉ®×
  11.         With Workbooks(Ar(i))
  12.             Set Rng(i) = .Sheets(1).Range("A1").CurrentRegion   '**³]©w­ÓÀɮתº¸ê®Æ½d³ò
  13.         End With
  14.     Next
  15.     With Rng(0)                         '**´ú¸Õ.XLSM ²M°£­n¾É¤J¸ê®Æªº½d³ò
  16.         .Range(.Cells(2, 2), .Cells(.Rows.Count, .Columns.Count)) = ""
  17.     End With
  18.     Set xRng = Rng(0).Cells(2, 1)       '**´ú¸Õ.XLSM: ²Ä¤@­Ó ¾Ç¸¹
  19.     Ar = Rng(0)                         '**´ú¸Õ.XLSM: ½d³ò¸ê®Æ¾É¤J°}¦C
  20.     Do While xRng <> ""                 '°j°é: ¾Ç¸¹ªº·j´M
  21.         For ii = 1 To UBound(Rng)
  22.             xR = Application.Match(xRng, Rng(ii).Columns(1), 0) '¤Ø¤o,¸ê®Æ ¤¤·j´M ¾Ç¸¹(ªº¦C¸¹)
  23.             If Not IsError(xR) Then                             '**·j´M¨ì ¾Ç¸¹(ªº¦C¸¹)
  24.                 For i = 2 To Rng(0).Rows(1).Cells.Count         '**´ú¸Õ Äæ¦ì¦WºÙ
  25.                     '**xC ¶Ç¦^¬O§_·j´M¨ì Äæ¦ì¦WºÙ
  26.                     xC = Application.Match(Rng(0).Cells(1, i), Rng(ii).Rows(1).Cells, 0)
  27.                     If Not IsError(xC) Then Ar(xRng.Row, i) = Rng(ii).Cells(xR, xC) '**¾É¤J¸ê®Æ¨ì°}¦C
  28.                 Next
  29.             End If
  30.         Next
  31.         Set xRng = xRng.Offset(1)           '**´ú¸Õ.XLSM: ¤U¤@­Ó ¾Ç¸¹
  32.     Loop
  33.     For i = 1 To UBound(Rng)
  34.         Rng(i).Parent.Parent.Close          '**Ãö³¬ "¤Ø¤o.XLSX", "¸ê®Æ.XLSX"
  35.     Next
  36.     Rng(0) = Ar                             '**°}¦C¸ê®Æ¾É¤J´ú¸Õ.XLSMªº½d³ò
  37.     Application.ScreenUpdating = True
  38. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 6# GBKEE


    ·PÁ¤À¨É¥t¤@°µªk¡A¤µ¤Ñ§âK¤jªºµ{¦¡½X¦L¥X¨ÓºCºC¬Ý
    µo²{¡A¯uªº«Ü¯«©_¡A¬°¤°»ò³£¨S¦³¤ñ¹ïªºªF¦è¦b? ´N¥i¥H°µ¨ì®ÄªG?
    §Ú¤ß¸Ì­±°_ªì¤]¬O¦b·Q  À³¸Ó­n¥Î­Ó IF °Õ  FIND°Õ  ¤§Ãþªº
    ¤£µM«ç»òª¾¹D  "´ú¸Õ"ªº¾Ç¸¹  ¸ò¥t¥~¨â­ÓÀɮתº¾Ç¸¹  ¤@¤£¤@¼Ë
    ¤@¼Ë¤~½Æ»s  ¤£¤@¼Ë´N¤£½Æ»s
   
<¤@>K¤j©~µM¥Î¤T­Ó°j°é´N·d©w¤F¡A§ÚµLªk²z¸Ñ°Ú......(¤Ó°ª²`¤F)

   µM«á§Ú¤µ¤Ñ¦Û¤v¹Á¸Õ­n¼g¤@­Ó¤pµ{¦¡
   ±q"´ú¸Õ"¸Ì­±³]¤@«ö¶s  «ö¤U«á  ·|¶}¤@­ÓAÀÉ®×   ¦Û°Ê­pºâÀɮפ¤ªºBÄ榳´X¦C¸ê®Æ
   µM«á§Ú´N³]©w¤@­Ó°}¦C  ­n§âBÄ檺¸ê®Æ¨C¤@¦C¦s°_¨Ó

   °²³]BÄæ§PÂ_§¹¦³12µ§¸ê®Æ  §ÚªºÅܼÆc´Nµ¥©ó12
   ¦ý¬O§ÚDim Arry(1,c)  §Ú­n¤@ºû12®æªº°}¦C
   ´N¬O·|¥X¿ù  ¸ò§Ú»¡¤@©w­n±`¼Æ
   ¨º§Ú¥ý Dim Arry()   µM«á  c=1   «ü©wArry(1,c) = 10   ³o¼Ë¤]¿ù  (±Y¼ì....)

    <¤G>·Q¶¶«K½Ð±Ð  ¨ì©³­n«ç»ò³]©w°ÊºAªº°}¦C§r?

<¤T>³o¬O¤@­ÓÅܧΪº¤ñ¹ï»Ý¨D
¤ñ¹ïªº¶¶§Ç¦b  "¸ê®Æ"Àɮפ¤
¦ý¬O "´ú¸Õ"Àɮפ¤¡A¦]¬°¿é¤J»Ý­n¤ñ¹ïªº¾Ç¸¹¶i¨Ó¡A¤£¤@©w³£¬O¥Ñ¤p¨ì¤j
¥i¯à0005  ¦A¨Ó0001  ¦A¨Ó0003
¨º§Ú§Æ±æ¦b«ö¤U«ö¶s«á   ¯à¦Û°Ê±Æ¦¨0001  0003  0005ªº¶¶§Ç  §â¸ê®Æ©ñ¶i "´ú¸Õ"Àɮפ¤

¬Æ¦Ü  ¥D¯Á¤ÞÁä  ­Y¬O§ï¦¨¥H¦W¦r¨Ó·í¥D­n¹ï·Ó
´N¬O¦b"´ú¸Õ"Àɮפ¤    ¥u¦³¿é¤J  ¦W¦r   ¨S¦³¾Ç¸¹
¤@¼Ë¯à¥H "¸ê®Æ"Àɮפ¤ªº¶¶§Ç¨Ó±Æ
¨Ã½Æ»s¹L¨Ó "´ú¸Õ"Àɮ׸Ì

¦³¿ìªk¶Ü?

¥H¤W¡AÁÂÁÂ
«¢Åo~¤j®a¦n§r

TOP

¦^´_ 7# iceandy6150

±Æ§Çªº°ÝÃD,§A¥i¥Î¿ý»s¥¨¶°½m²ß¬Ý¬Ý
  1. Option Explicit
  2. Sub Ex()
  3.     Dim ar(), c As Integer, i As Integer
  4.     '**ReDim ³¯­z¦¡ ¦bµ{§Ç¼h¦¸¤¤¥Î¨Ó­«·s°t¸m°ÊºA°}¦CÅܼƪºÀx¦sªÅ¶¡¡C
  5.     ReDim ar(0 To 2)
  6.     For i = 0 To UBound(ar)
  7.         ar(i) = Chr(65) & i
  8.     Next
  9.     MsgBox UBound(ar) & vbLf & Join(ar, ",")
  10.     c = 8
  11.     ReDim ar(1 To c)
  12.     For i = 1 To UBound(ar) Step 2
  13.         ar(i) = Chr(66) & i
  14.     Next
  15.    
  16.     MsgBox UBound(ar) & vbLf & Join(ar, " , ")
  17.     ReDim Preserve ar(1 To c + 10)
  18.     '**  Preserve ¿ï¾Ü©Ê¤Þ¼Æ¡C·í§ïÅܭ즳°}¦C³Ì«á¤@ºûªº¤j¤p®É¡A¤´µM«O¦³­ì¨Óªº¸ê®ÆªºÃöÁä¦r
  19.     For i = c + 1 To UBound(ar) Step 3
  20.         ar(i) = i & Chr(67)
  21.    
  22.     Next
  23.     MsgBox UBound(ar) & vbLf & Join(ar, ",,")
  24.    
  25. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 8# GBKEE


    ÁÂÁÂ~ §Ú¦A¸Õ¸Õ

   ªì¨B¨Ï¥ÎÅܼƵøµ¡  ¬Oª¾¹D¥ý§â©Ò¦³¸ê®Æ©ñ¶i¤@­Ó¤j°}¦C

  µM«á¦A¥h²Ä¤G­ÓÀÉ®×¥´¶}

  ¦ý¬O¨S¦³ IF¨Ó°µ¤ñ¸û¡A«ç»òª¾¹D²Ä¤G­ÓÀÉ®×­n©ñ¤°»ò©O

¨Ï¥Î¿ý»s¥¨¶°­n«ç»ò¬Ý?  §âµ{¦¡½X¶K¶i¥h«ö¶s¹À? «ç»ò¬Ý¥¦¦Û¤v¤@¨B¤@¨B¶]?
«¢Åo~¤j®a¦n§r

TOP

¦pªG¥u¬O²³æ¬d¸ß, ¸ê®Æ¤]¤£¦h, ¥i¥Î¤½¦¡:
Sub ¥¨¶°1()
P$ = ThisWorkbook.Path & "\"
With Range("D2", Cells(Rows.Count, 1).End(xlUp)(2, 2))
     .Columns(1) = "=VLOOKUP(A2,'" & P & "[¸ê®Æ.xlsx]¤u§@ªí1'!A:D,2,)"
     .Columns(3) = "=VLOOKUP(A2,'" & P & "[¸ê®Æ.xlsx]¤u§@ªí1'!A:D,4,)"
     .Columns(2) = "=VLOOKUP(A2,'" & P & "[¤Ø¤o.xlsx]¤u§@ªí1'!A:D,2,)"
     .Value = .Value
     .Replace "#N/A", ""
End With
End Sub

TOP

        ÀR«ä¦Û¦b : ¶¢¤HµL¼Ö½ì¡A¦£¤HµL¬O«D¡C
ªð¦^¦Cªí ¤W¤@¥DÃD