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

[µo°Ý] ½Ð°ÝVBA¥i¥H°µ¨ì¨âÀɮפñ¹ï«á¦A²£¥Í¥t¤@Àɮתº¤ñ¹ïµ²ªG¶Ü?

¦^´_ 30# stillfish00


    «¢Åo~stillfish00

¤Ó´Î¤F~~^^ ¤Ó·P®¦~

¥u¬OÁÙ¦³¨â­Ó¤p°ÝÃD~
1.¥Ø«e­Y¬OªÅ¥ÕªºÄæ¦ì¥L¤]·|°µ§PÂ_

­YB.xlsxªº"K"Äæ¬OªÅ¥Õªº

¥L·|¥hŪ¨ú¸ê®Æ®wªº"E"ÄæªÅ¥Õ¦ì¸m²Ä¤@­Óªº¹ïÀ³­È ¼g¦b·sÀɮ׸̭± ¦ý¬O¨ä¹ê¨ºÄæÀ³¸Ó­n¬OªÅ¥Õ

2.­Y¬O¸ê®Æ®wªº"E"Äæ¦ì ¦P®É¦b"A"Äæ¦ì¦³¨âµ§¥H¤W¹ïÀ³ ¨º«ç»ò¤ñ¹ï¥X¨Ó?
   ¥Ø«e¸òVLOOKUP¤@¼Ë¥u¯à¤@¹ï¤@ VBA¥i°µ¥X¤@¹ï¦h¶Ü?

   ¦Ó¥»¦¸¤ñ¹ïµ²ªG¥X¨Ó¤£¬O¹ïÀ³¨ì²Ä¤@µ§ ¦Ó¬OªÅ¥Õ¦æ«áªº²Ä¤@µ§(½Ð¨£ªþÀÉBook21.xlsx)

ABC_0802.zip (30.5 KB)


ÁÂÁÂÁÂÁÂ!!!!«ùÄò¬ãŪ¤¤

TOP

¦^´_ 31# happycoccolin
¤W¶Çªº¨Ò¤l¡AºÉ¶q«O¯d­ì¥»¸ê®Æªº¯S©Ê(¦p:¬O§_§t¼ÐÀY¡B¬O§_¦³ªÅ¥Õ¡B¬O§_·|¦³­«½Æ¶µµ¥µ¥)¡A¤~·|¤ñ¸û²Å¦X¹ê»Ú·Q­nªºµ²ªG¡C
  1. Sub TEST()
  2.   Const DATABASE_NAME = "A" '¸ê®Æ®w¤u§@ªí¦WºÙ
  3.   Const DATABASE_COL = 5  'EÄæ
  4.   Const COMPARE_COL = 11  'KÄæ
  5.   
  6.   Dim d, ar, filein, fileout, s As String, i As Long
  7.   
  8.   Set d = CreateObject("scripting.dictionary")
  9.   With Sheets(DATABASE_NAME)
  10.     ar = .[A1].CurrentRegion.Resize(.Cells(.Rows.Count, "A").End(xlUp).Row).Value
  11.   End With
  12.   For i = 2 To UBound(ar)
  13.     s = Replace(ar(i, DATABASE_COL), "-", "")
  14.     If s <> "" Then
  15.       If d.exists(s) Then
  16.         d(s) = d(s) & "," & ar(i, 1)
  17.       Else
  18.         d(s) = ar(i, 1)
  19.       End If
  20.     End If
  21.   Next
  22.   
  23.   filein = Application.GetOpenFilename(FileFilter:="Excel ¬¡­¶Ã¯ (*.xlsx),*.xlsx", Title:="¿ï¾Ü­n¤ñ¹ïªºÀÉ®×")
  24.   If Not TypeName(filein) = "String" Then Exit Sub '¨ú®ø«hµ²§ô
  25.       
  26.   Application.ScreenUpdating = False
  27.   With Workbooks.Open(filein).Sheets(1)
  28.     ar = .[A1].CurrentRegion.Resize(.Cells(.Rows.Count, "A").End(xlUp).Row).Value
  29.     .Parent.Close False
  30.   End With
  31.   Application.ScreenUpdating = True
  32.   
  33.   ReDim Preserve ar(LBound(ar) To UBound(ar), LBound(ar, 2) To UBound(ar, 2) + 1)
  34.   For i = LBound(ar) + 1 To UBound(ar)
  35.     If ar(i, COMPARE_COL) <> "" Then
  36.       s = Replace(ar(i, COMPARE_COL), "-", "")
  37.       If d.exists(s) Then
  38.         ar(i, UBound(ar, 2)) = d(s)
  39.       Else
  40.         ar(i, UBound(ar, 2)) = "No Data"
  41.       End If
  42.     End If
  43.   Next
  44.   
  45.   With Workbooks.Add
  46.     Application.ScreenUpdating = False
  47.     With .Sheets(1).[A1].Resize(UBound(ar), UBound(ar, 2))
  48.       .Value = ar
  49.       .Font.Name = "Verdana"  '¦rÅé¦WºÙ
  50.       .Font.Size = 14 '¦rÅé¤j¤p
  51.       .Borders.LineStyle = xlContinuous '®Ø½u
  52.       .EntireColumn.AutoFit '½Õ¾ãÄæ¼e
  53.       
  54.       .Rows(1).Interior.Color = 12567966  '¼ÐÀYÃC¦â
  55.       .Rows(1).Font.Bold = True  '¼ÐÀY²ÊÅé¦r
  56.     End With
  57.     Application.ScreenUpdating = True
  58.    
  59.     If MsgBox("¬O§_­nÀx¦sÀÉ®×?", vbYesNo) = vbYes Then
  60.       fileout = Application.GetSaveAsFilename(FileFilter:="Excel ¬¡­¶Ã¯ (*.xlsx),*.xlsx", Title:="¥t¦s¬°·sÀÉ")
  61.       If Not TypeName(fileout) = "String" Then Exit Sub '¨ú®ø«hµ²§ô
  62.       .SaveAs fileout, FileFormat:=xlWorkbookDefault
  63.     End If
  64.   End With
  65. End Sub
½Æ»s¥N½X

TOP

¦^´_ 32# stillfish00


    «¢Åo~~stillfish00

¤]¤Ó§Ö³t¤F~~©êºp¦£¤¤¦³¿ù~½m²ßªºÀɮפӦh·d²V¤F~

·PÁÂÀ°¦£¸Ñµª~~~

¦A°Ý¤@­Ó°ÝÃD

¤@¹ï¦h­«½Æªº¸ê®Æ¤¤¬O§_¥i¥H¥u¨ú¤£­«½Æªº¨Ã¦b¦P¤@Äæ¦ì¤º°µ´«¦æ°Ê§@©O?

ÁÙ¦³­Y¬O²£¥ÍªºÀɮר䤤¤@Äæ¦ì¤Ó¼e¤j¥i¥H¥ÎVBA³B²zÅý¥L³Ì¤j¥u¨ìÄæ¼e50(¨Ã¦Û°Ê´«¦C)³o¤@Ãþªº³]©w¶Ü?

©êºp¤p©f³oªì¾ÇªÌ°Ýªº°ÝÃD³£«Ü²ö¦W¨ä§® ¤]ÁÂÁ§A­Ì¯à°÷­@¤ß¸Ñµª

¦A¦¸ÁÂÁÂÁÂÁ¡ã~~~~

TOP

¦^´_ 32# stillfish00


    «¢Åo¡ãstillfish00

§Úª¾¹D¤F¡@¤U¦¸·|ª`·N¡@·PÁ¤j¤jªº­@¤ß¸Ñµª

TOP

¦^´_ 33# happycoccolin
­Y¬O²£¥ÍªºÀɮר䤤¤@Äæ¦ì¤Ó¼e¤j¥i¥H¥ÎVBA³B²zÅý¥L³Ì¤j¥u¨ìÄæ¼e50(¨Ã¦Û°Ê´«¦C)

§A«üªº¹ï¶H¬O«ü¦Û°Ê½Õ¾ãÄæ¼e«áªº©Ò¦³Äæ³£Àˬd¡AÁÙ¬O¥u­n³æ¤@Äæ(­þ¤@Äæ?)

TOP

¦^´_ 35# stillfish00


   HELLO~stillfish00

¥Ø«e¬O"K"Äæ»P"M"Äæ,¦]¬°¸ê®Æ¶q¤ñ¸û¦h ©Ò¥H³£·|©Ô¨ìÄæ¼e250¥ª¥k~

TOP

¦^´_ 35# stillfish00


    HELLO~~~SORRY~~~­è­è¼g¿ù¤F~~~

¥Ø«e¬O"F"Äæ»P"M"Äæ,¦]¬°¸ê®Æ¶q¤ñ¸û¦h ©Ò¥H³£·|©Ô¨ìÄæ¼e250¥ª¥k~

TOP

¥»©«³Ì«á¥Ñ stillfish00 ©ó 2013-8-2 14:13 ½s¿è

¦^´_ 33# happycoccolin
¤@¹ï¦h­«½Æªº¸ê®Æ¤¤¬O§_¥i¥H¥u¨ú¤£­«½Æªº¨Ã¦b¦P¤@Äæ¦ì¤º°µ´«¦æ°Ê§@©O?
ÁÙ¦³­Y¬O²£¥ÍªºÀɮר䤤¤@Äæ¦ì¤Ó¼e¤j¥i¥H¥ÎVBA³B²zÅý¥L³Ì¤j¥u¨ìÄæ¼e50(¨Ã¦Û°Ê´«¦C)³o¤@Ãþªº³]©w¶Ü?
  1. Sub TEST()
  2.   Const DATABASE_NAME = "A" '¸ê®Æ®w¤u§@ªí¦WºÙ
  3.   Const DATABASE_COL = 5  'EÄæ
  4.   Const COMPARE_COL = 11  'KÄæ
  5.   
  6.   
  7.   Dim d, ar, filein, fileout, s As String, i As Long
  8.   
  9.   Set d = CreateObject("scripting.dictionary")
  10.   With Sheets(DATABASE_NAME)
  11.     ar = .[A1].CurrentRegion.Resize(.Cells(.Rows.Count, "A").End(xlUp).Row).Value
  12.   End With
  13.   For i = 2 To UBound(ar)
  14.     s = Replace(ar(i, DATABASE_COL), "-", "")
  15.     If s <> "" Then
  16.       If Not d.exists(s) Then Set d(s) = CreateObject("scripting.dictionary")
  17.       d(s)(ar(i, 1)) = ""   '²Ä¤G¼h¦r¨å¡A¥Î¨Ó¿z¿ï±¼­«½ÆªºAÄæ­È
  18.     End If
  19.   Next
  20.   
  21.   filein = Application.GetOpenFilename(FileFilter:="Excel ¬¡­¶Ã¯ (*.xlsx),*.xlsx", Title:="¿ï¾Ü­n¤ñ¹ïªºÀÉ®×")
  22.   If Not TypeName(filein) = "String" Then Exit Sub '¨ú®ø«hµ²§ô
  23.       
  24.   Application.ScreenUpdating = False
  25.   With Workbooks.Open(filein).Sheets(1)
  26.     ar = .[A1].CurrentRegion.Resize(.Cells(.Rows.Count, "A").End(xlUp).Row).Value
  27.     .Parent.Close False
  28.   End With
  29.   Application.ScreenUpdating = True
  30.   
  31.   ReDim Preserve ar(LBound(ar) To UBound(ar), LBound(ar, 2) To UBound(ar, 2) + 1)
  32.   For i = LBound(ar) + 1 To UBound(ar)
  33.     If ar(i, COMPARE_COL) <> "" Then
  34.       s = Replace(ar(i, COMPARE_COL), "-", "")
  35.       If d.exists(s) Then
  36.         ar(i, UBound(ar, 2)) = Join(d(s).keys, vbLf)
  37.       Else
  38.         ar(i, UBound(ar, 2)) = "No Data"
  39.       End If
  40.     End If
  41.   Next
  42.   
  43.   With Workbooks.Add
  44.     Application.ScreenUpdating = False
  45.     With .Sheets(1).[A1].Resize(UBound(ar), UBound(ar, 2))
  46.       .Value = ar
  47.       .Font.Name = "Verdana"  '¦rÅé¦WºÙ
  48.       .Font.Size = 14 '¦rÅé¤j¤p
  49.       .Borders.LineStyle = xlContinuous '®Ø½u
  50.       .EntireColumn.AutoFit '½Õ¾ãÄæ¼e
  51.       
  52.       .Rows(1).Interior.Color = 12567966  '¼ÐÀYÃC¦â
  53.       .Rows(1).Font.Bold = True  '¼ÐÀY²ÊÅé¦r
  54.       
  55.       'Äæ¼e­­¨î¤Î¦Û°Ê´«¦æ
  56.       With .Columns("F")
  57.         If .Width > 250 Then
  58.           .Width = 250
  59.           .WrapText = True
  60.         End If
  61.       End With
  62.       With .Columns("M")
  63.         If .Width > 250 Then
  64.           .Width = 250
  65.           .WrapText = True
  66.         End If
  67.       End With
  68.     End With
  69.     Application.ScreenUpdating = True
  70.    
  71.     If MsgBox("¬O§_­nÀx¦sÀÉ®×?", vbYesNo) = vbYes Then
  72.       fileout = Application.GetSaveAsFilename(FileFilter:="Excel ¬¡­¶Ã¯ (*.xlsx),*.xlsx", Title:="¥t¦s¬°·sÀÉ")
  73.       If Not TypeName(fileout) = "String" Then Exit Sub '¨ú®ø«hµ²§ô
  74.       .SaveAs fileout, FileFormat:=xlWorkbookDefault
  75.     End If
  76.   End With
  77. End Sub
½Æ»s¥N½X

TOP

¥»©«³Ì«á¥Ñ happycoccolin ©ó 2013-8-2 14:32 ½s¿è

¦^´_ 38# stillfish00


    «¢Åo~~~~~~~½Ð°Ý¤@¤U~~¥Ø«eª¬ªp¦p¤U

With .Columns("F")
        If .Width > 250 Then
          .Width = 250 (°»¿ù°±¦b³o¤@¦æ)
          .WrapText = True
        End If
      End With
      With .Columns("M")
        If .Width > 250 Then
          .Width = 250
          .WrapText = True
        End If

"F"Äæ¥i¤£¥Î³vµ§¸ê®Æ¦Û°Ê´«¦C ¥u­n½Õ¾ãÄæ¼e´N¦n

TOP

¦^´_ 39# happycoccolin
©êºp¡A½Ð±N .Width ³£§ï¬° .ColumnWidth¡A250§ï¬°¾A¦XªºÄæ¼e(«D¹³¯À)

TOP

        ÀR«ä¦Û¦b : §g¤l¥ß«í§Ó¡A¤p¤H«í¥ß§Ó¡C
ªð¦^¦Cªí ¤W¤@¥DÃD