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

[µo°Ý] ½Ð°Ývba¬O§_¥i¥H¨Ì«ü©w±ø¥ó½Æ»s¥X¤£¦Pexcel¤u§@ªí?

[µo°Ý] ½Ð°Ývba¬O§_¥i¥H¨Ì«ü©w±ø¥ó½Æ»s¥X¤£¦Pexcel¤u§@ªí?

¦U¦ì¤j¤j¦n,

¦]¬°¤½¥q­û¤uªºÁ~¸êµ²ºc¤£¦P,¨C¤ë³£¥²¶·¤â°Ê¥Hexcel »s§@Á~¸ê±ø«á¦A¥HpdfÀÉ¥[±K±Hµ¹­û¤u,«D±`¯Ó®É¤S®e©ö¥X¿ù.
½Ð°Ý¬O§_¥i©óexcel ¤¤³]©w¥¨¶°ª½±µ½Æ»s¥X¤£¦P¤u§@ªí¨Ã±a¤J¬Û¹ïÀ³¸ê®Æ?
¤ñ¦pªþ¥ó¤¤,Á~¸ê·JÁ`­pºâ©ó"Á`ªí", ­û¤u¥Ò~¥³¾A¥ÎªºÁ~¸ê±ø®æ¦¡¤À§O¦p¤U:
­û¤u©m¦W        ¾A¥Îªí³æ
¥Ò        A
¤A        B
¤þ        C
¤B        B
¥³        A

Test.rar (21.1 KB)

½Ð°Ý:
   Q1: ¬O§_¥i¦Û°Ê²£¥Í¤u§@ªí¦WºÙ¤À§O¬°­û¤u©m¦W"¥Ò"~"¥³"ªºÁ~¸ê±ø¨Ã±N¬ÛÃö¼Æ¾Ú±a¤J?
   Q2: §¹¦¨«á¥i§_ÂàÀɬ°¥[±KªºpdfÀÉ?

³Â·Ð&·PÁ¦U¦ìÅo!

Test.rar (21.1 KB)

Test.rar (21.1 KB)

Test.rar (21.1 KB)

kathych

¦^´_ 1# kathych

  1. Private Sub cbCreat_Click()
  2.   Dim iCol%, iCols%
  3.   Dim lSRow&, lTRow&
  4.   Dim sStr$
  5.   Dim bNDone As Boolean
  6.   Dim wsTar As Worksheet
  7.   Dim vD As Object
  8.   
  9.   Set vD = CreateObject("Scripting.Dictionary")

  10.   With Sheets("Á`ªí")
  11.     iCols = .Cells(2, Columns.Count).End(xlToLeft).Column
  12.     iCol = 1
  13.     While iCol <= iCols
  14.       If .Cells(2, iCol) <> "" Then vD(Trim(.Cells(2, iCol))) = iCol
  15.       iCol = iCol + 1
  16.     Wend
  17.    
  18.     lSRow = 3
  19.     While .Cells(lSRow, 1) <> ""
  20.       Set wsTar = Sheets(.Cells(lSRow, 2) & " Form")
  21.       wsTar.[C2:C16].ClearContents
  22.       lTRow = 2
  23.       bNDone = True
  24.       While bNDone
  25.         If wsTar.Cells(lTRow, 2) <> "" And wsTar.Cells(lTRow, 2) <> "´î:" Then
  26.           sStr = Trim(wsTar.Cells(lTRow, 2))
  27.         If wsTar.Cells(lTRow, 2) = "¹ê»âª÷ÃB" Then
  28.           sStr = "²bÃB"
  29.           bNDone = False
  30.         End If
  31.           If InStr(1, sStr, ":") <> 0 Then sStr = Left(sStr, InStr(1, sStr, ":") - 1)
  32.           wsTar.Cells(lTRow, 3) = .Cells(lSRow, vD(sStr))
  33.         End If
  34.         lTRow = lTRow + 1
  35.       Wend
  36.       ' ³o¸Ì©ñÂনPDFÀɪº«ü¥O,®É¶¡Ãö«Y¨Ó¤£¤Î°µ
  37.       wsTar.PrintPreview
  38.       wsTar.[C2:C16].ClearContents
  39.       lSRow = lSRow + 1
  40.     Wend
  41.   End With
  42. End Sub
½Æ»s¥N½X
Test-a.zip (18 KB)

TOP

¤j¤j,«D±`·PÁ±z,´ú¸Õµ²ªG«Ü¦¨¥\.

¦ý¨Ì¦ÑÁó«ü¥Ü»Ý°µ¥H¤U´XÂI­×§ï,»Ý­n±zªº¶i¤@¨B¨ó§U.
1. A~Cªº¨î¦¡ªí³æ§ï¨Ì"¾ºÙ"©R¦W¥B®æ¦¡µy§@­×§ï(=>±NÁ~¸ê´î¶µ¥t¦C©ó·s¼WÄæ¦ì)
2. »Ý§ï¬°²£¥X¥H­û¤u©m¦W©R¦WªºExcelÁ~¸ê±ø,¦]¬°¦³®É»Ý¦A¥t¦æ¥[µù»¡©ú¤@¨Ç¨Æ¶µ.
p.s. ­YµLªkÅý¥[µù»¡©ú«áªºexcelÁ~¸ê±ø¥H¥¨¶°ª½±µÂন¥[±Kpdf,«hÂনpdfªº¥\¯à¥i¥ý¤£¥Î¦Ò¼{¦C¤J.

¦A¦¸³Â·Ð±z¤F,ÁÂÁÂ!
Test2.rar (16.87 KB)
kathych

TOP

¥»©«³Ì«á¥Ñ luhpro ©ó 2016-5-1 05:16 ½s¿è

¦^´_ 3# kathych
  1. Private Sub cbCreat_Click()
  2.   Dim iCol%, iCols%
  3.   Dim lSRow&, lTRow&
  4.   Dim sPath$, sStr1$, sStr2$
  5.   Dim wsTar As Worksheet
  6.   Dim vD As Object
  7.   
  8.   Set vD = CreateObject("Scripting.Dictionary")
  9.   sPath = ThisWorkbook.Path
  10.   ChDrive sPath
  11.   ChDir sPath
  12.   
  13.   With Sheets("Á`ªí")
  14.     iCols = .Cells(2, Columns.Count).End(xlToLeft).Column
  15.     iCol = 1
  16.     While iCol <= iCols
  17.       If .Cells(2, iCol) <> "" Then vD(Trim(.Cells(2, iCol))) = iCol
  18.       iCol = iCol + 1
  19.     Wend
  20.    
  21.     lSRow = 3
  22.     While .Cells(lSRow, 1) <> ""
  23.       Set wsTar = Sheets(CStr(.Cells(lSRow, 2)))
  24.       With wsTar
  25.         .[C2:C14].ClearContents
  26.         .[E3:E14].ClearContents
  27.         With .[E2] ' ¤ë©³¨º¶g´N¥i¥H²£¥Í¦¸¤ëªºÁ~¸ê±ø
  28.           .NumberFormat = "mmm.,yyyy"
  29.           .Value = Now() - 7
  30.         End With
  31.       End With
  32.       
  33.       wsTar.[C2] = .Cells(lSRow, vD("­û¤u©m¦W"))
  34.       
  35.       lTRow = 3
  36.       Do While 1
  37.         If wsTar.Cells(lTRow, 2) <> "" Or wsTar.Cells(lTRow, 4) <> "" Then
  38.           sStr1 = Trim(wsTar.Cells(lTRow, 2))
  39.           If sStr1 = "Total" Then Exit Do ' ¹J¨ì Total ¸õ¥X°j°é
  40.           sStr2 = Trim(wsTar.Cells(lTRow, 4))
  41.           If sStr1 <> "" Then wsTar.Cells(lTRow, 3) = .Cells(lSRow, vD(sStr1))
  42.           If sStr2 <> "" Then wsTar.Cells(lTRow, 5) = .Cells(lSRow, vD(sStr2))
  43.         End If
  44.         lTRow = lTRow + 1
  45.       Loop
  46.       
  47.       With wsTar
  48.         .Copy ' ¸g¹ê´ú,¥»¦æ¸õ¦æ®É·|¥t²£¥Í¤@­Ó¤u§@ï¨Ã¶K¤W²Ä¤@­Ó¤u§@ªí, ©Ò¥H¥i¥H¤£¥Î¥[ PasteSpecial «ü¥O
  49.         With ActiveSheet
  50.           .Name = "Á~¸ê±ø"
  51.           With .Parent
  52.             .SaveAs wsTar.[C2] & "-" & Format(wsTar.[E2], "yyyymm") & "Á~¸ê±ø.xls"
  53.             .Close
  54.           End With
  55.         End With
  56.         
  57.         .PrintPreview
  58.         ' ³o¸Ì©ñÂনPDFÀɪº«ü¥O,ÁÙ¨S´ú¸Õ¥X¨Ó«ç»ò°µ
  59.       
  60.         .[C2:C14].ClearContents
  61.         .[E3:E14].ClearContents
  62.       End With
  63.       lSRow = lSRow + 1
  64.     Wend
  65.   End With
  66. End Sub
½Æ»s¥N½X
Test2-a.zip (17.51 KB)

TOP

¥»©«³Ì«á¥Ñ ­ã´£³¡ªL ©ó 2016-5-1 11:36 ½s¿è

¤½¦¡+VBA,
¥u¯à²£¥Í¬¡­¶Ã¯, PDF¦Û¦æ¥h·Q¿ìªk,
  1. Sub TEST()
  2. Dim xR As Range, xS As Worksheet, xPH$
  3. xPH = ThisWorkbook.Path & "\"
  4. [Á`ªí!2:2].Replace " ", "", LookAt:=xlPart
  5. Application.ScreenUpdating = False
  6. For Each xR In Range([Á`ªí!A3], [Á`ªí!A65536].End(xlUp))
  7.     If xR.Row < 3 Then Exit Sub
  8.     If xR = "" Or xR(1, 2) = "" Then GoTo 101
  9.     Set xS = Sheets(xR(1, 2) & "")
  10.     xS.[C2] = xR
  11.     xS.[E2] = Format(Date - 7, "mmm.,yyyy")
  12.    
  13.     xS.[C3:C12,E3:E12].FormulaR1C1 = "=VLOOKUP(R2C3,Á`ªí!C1:C18,MATCH(TRIM(RC[-1]),Á`ªí!R2,),)"
  14.     With xS.[C3:E12]
  15.          .Value = .Value
  16.          .Replace "#N/A", "", LookAt:=xlWhole
  17.          .Replace "0", ""
  18.     End With
  19.    
  20.     xS.Copy
  21.     Application.DisplayAlerts = False
  22.     With ActiveWorkbook
  23.          .Sheets(1).Name = "Á~¸ê±ø"
  24.          .SaveAs xPH & xR & "-" & Format(Date - 7, "yyyymm") & "¤ëÁ~¸ê±ø.xls", CreateBackup:=False
  25.          .Close
  26.     End With
  27.     xS.[C3:C12,E3:E12,C2,E2] = ""
  28. 101: Next
  29. End Sub
½Æ»s¥N½X
ªþÀÉ¡G
Xl0000004.rar (14.4 KB)
¥t¤@¸ü§}¡G
http://www.funp.net/954803¡@

TOP

¦^´_ 5# ­ã´£³¡ªL

­Y¦³¦w¸Ë Adobe Acrobat ±M·~ª©®É¡A¥Î¦sÀɬ° PDF´N¥i

­ìµ{¦¡
        '    With ActiveWorkbook
        '         .Sheets(1).Name = "Á~¸ê±ø"
        '         .SaveAs xPH & xR & "-" & Format(Date - 7, "yyyymm") & "¤ëÁ~¸ê±ø.xls", CreateBackup:=False
        '         .Close
        '    End With
§ï¬°
        With ActiveWorkbook
            .Sheets(1).Name = "Á~¸ê±ø"
            ActiveSheet.ExportAsFixedFormat _
                    Type:=xlTypePDF, Filename:=xPH & xR & "-" & Format(Date - 7, "yyyymm") & "¤ëÁ~¸ê±ø.pdf", _
                    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                    OpenAfterPublish:=True
            .Close
        End With
{...} ªí¥Ü»Ý­n¥Î CTRL+SHIFT+ENTER ¤TÁä¿é¤J¤½¦¡

TOP

«D±`·PÁ¦U¦ì,´ú¸Õ¦¨¥\
~~ÁöµMÁÙ¦b«ä¯Áµ{¦¡ªº·N«ä¤~¯àÅý¥¦®M¥Î¦b§Úªº¤é±`§@·~¤¤.

·Q½Ð°Ýª©¤j,¥i¥H¥ýÀ°§Ú¸Ñ´b¥H¤Uªº·N«ä¶Ü? ¤£¬Æ·P¿E! ÁÂÁÂ!
xS.[C3:C12,E3:E12].FormulaR1C1 = "=VLOOKUP(R2C3,Á`ªí!C1:C18,MATCH(TRIM(RC[-1]),Á`ªí!R2,),)"
kathych

TOP

¥»©«³Ì«á¥Ñ ­ã´£³¡ªL ©ó 2016-5-4 20:16 ½s¿è

¦^´_ 7# kathych


¡e·~°È¡f¤u§@ªí¡A¢Ñ¢±¿é¤J¡e¥Ò¡f¡A
¢Ñ¢²¡G=VLOOKUP($C$2,Á`ªí!$A:$R,MATCH(TRIM(B3),Á`ªí!$2:$2,),)
¤½¦¡¤U©Ô¦Ü¢Ñ¢°¢±¡A¦A¶K¦Ü¢Ó¢²¡G¢Ó¢°¢±
³o³Ì°ò¥»ªºVLOOKUP¨ç¼Æ¡AÀ³¤£¶·¦h°µ¸ÑÄÀ¡A
±N¤½¦¡¶K¦¨¡e­È¡f¡A³o®É¤½¦¡­È¦³¡e¼Æ¦r¡D¢¯¡D¿ù»~­È(#N/A)¡f¤TºØµ²ªG¡A
¥H¤Uµ{¦¡§Y°µ¥[¤u³B²z¡G¥H¡e¨ú¥N¡f¤èªk¡A²M°£¡e¢¯¡D¿ù»~­È(#N/A)¡f
With xS.[C3:E12]
¡@¡@¡@.Value = .Value
¡@¡@¡@.Replace "#N/A", "", LookAt:=xlWhole
¡@¡@¡@.Replace "0", ""
End With

µ{¦¡½Xªº¤½¦¡¡G.FormulaR1C1 = "=VLOOKUP(R2C3,Á`ªí!C1:C18,MATCH(TRIM(RC[-1]),Á`ªí!R2,),)"
¬O¥Î¡e¿ý»s¡f¨ú±oªº¡A¥i¦Û¦æ¸Õ¬Ý¬Ý¡I¡I¡I

·|¥Î TRIM(B3) ¬O¦]¬°¢Ð¢²¤å¦r§t¦³¡eªÅ¥Õ¦r¤¸¡f¡A¥²¶·¥h°£¡A¤~¯à·Ç½T§ì¨ú¹ïÀ³­È¡A
¥t¡D¡eÁ`ªí¡fªº¡e¼ÐÃD¦C¡D²Ä¤G¦C¡fªº¤å¦r¤]¥i¯à¦]¿é¤J¤â»~¦Ó§tªÅ¥Õ¦r¤¸¡A
©Ò¥Hµ{¦¡¶}ÀY§Y¥H¡G
[Á`ªí!2:2].Replace " ", "", LookAt:=xlPart¡@°µ¨ú¥N¡A¥H²M°£ªÅ¥Õ¦r¤¸!

TOP

ÁÂÁª©¤jªº»¡©ú,¤w¸g¤F¸Ñ¤F.
kathych

TOP

        ÀR«ä¦Û¦b : ¤ß¤¤±`¦sµ½¸Ñ¡B¥]®e¡B·P«ä¡Bª¾¨¬¡B±¤ºÖ¡C
ªð¦^¦Cªí ¤W¤@¥DÃD