我的VBA自定义函数研习收获

weiyingde

microyip 发表于 2019-10-3 14:49
随机文件，很多类似sr1,sr2等使用数组，更容易便捷调用

前面得到你的不少指教和帮助，此番又得到大侠指教，甚幸！
字典我还是出在懵懵懂懂的阶段，用起来不熟。
即便是数组，当它与字典（特别是字典嵌套）是，更是懵懂得一塌糊涂。
再次谢谢了。

weiyingde

带参数的过程，相当于函数。可以反复调用。
Public Sub 输出(sht As Worksheet, r1 As Integer, c1 As Integer, Num As Integer, Optional istr As String)
'作用：将指定区域的数据，合并为字符串（参数istr为“zf”时），或写作为数组形式(参数istr为“sz”时），便于写进VBA代码之中。
'参数说明：
'         sht：为指定工作表
'         r1：为指定列数据的第一个数据所在的行数；
'         c1:为数据所在列的列数。
'         Num:为生成字符每行的个数
'         istr:为生成的字符串形式。“zf"时，为VBA代码中的字符形式；"sz"为VBA代码中的数组形式。
Dim arr() as string, r As Integer
With sht
     For r = .Cells(65536, c1).End(3).Row To 1 Step -1
          If Len(.Cells(r, c1)) >= 20 Then .Cells(r, c1).ClearContents
     Next
     rw = .Cells(65536, c1).End(3).Row
     Select Case istr
            Case "zf"
                  For i = 1 To Int((rw - r1 + 1) / Num) + 1
                     For j = (i - 1) * Num + r1 To Num * i + r1 - 1
                         isr = isr & IIf(j <= rw, Cells(j, c1), "") & IIf(j < rw, ",", "")
                     Next
                         n = n + 1
                         ReDim Preserve arr(1 To n)
                         isr = IIf(i = 1, "isr = ", "") & Chr(34) & isr & Chr(34) & IIf(n <> Int((rw - r1 + 1) / Num) + 1, " & _", "")
                         arr(n) = isr
                         isr = ""
                  Next
                         .Cells(rw + 1, c1).Resize(UBound(arr), 1) = Application.WorksheetFunction.Transpose(arr)
            Case "sz"
                  For i = 1 To Int((rw - r1 + 1) / Num) + 1
                     For j = (i - 1) * Num + r1 To Num * i + r1 - 1
                         isr = isr & IIf(j <= rw, Chr(34), "") & Cells(j, c1) & IIf(j <= rw, Chr(34), "") & IIf(j < rw, ",", "")
                     Next
                         n = n + 1
                         ReDim Preserve arr(1 To n)
                         isr = IIf(i = 1, "arr=Array(", "") & isr & IIf(n <> Int((rw - r1 + 1) / Num) + 1, " _", ")")
                         arr(n) = isr
                         isr = ""
                  Next
                         .Cells(rw + 1, c1).Resize(UBound(arr), 1) = Application.WorksheetFunction.Transpose(arr)
     End Select
End With
End Sub
Sub 调用1()
Call 输出(ActiveSheet, 2, 2, 30, "zf")
End Sub
Sub 调用2()
Call 输出(ActiveSheet, 2, 2, 30, "sz")
End Sub

weiyingde

Public Sub 插入文本框(nm, lt, tp, wh, ht, wb)
'参数说明：
‘nm,插入对象的名字；
'lt，左边位置；tp，上部位置；wh，宽度，ht，高度，wb文本
On Error Resume Next
Dim sld As Slide, shp As Shape
    Set sld = ActivePresentation.SlideShowWindow.View.Slide
    For Each shp In sld.Shapes
         If shp.Name = "生词" Then shp.Delete
         If shp.Name = "拼音" Then shp.Delete
    Next
    With sld.Shapes.AddTextbox(1, lt, tp, wh, ht)
            .Name = nm
            .ZOrder msoBringToFront
            .Fill.ForeColor.RGB = IIf(nm = "生词", vbGreen, vbBlue)
            .TextFrame.HorizontalAnchor = msoAnchorCenter
            .TextFrame.TextRange.Text = wb
            .TextFrame.TextRange.Font.Name = "华文楷书"
            .TextFrame.TextRange.Font.Color.RGB = IIf(nm = "生词", vbRed, vbCyan)
            With .ThreeD
                 .BevelTopType = msoBevelCross
                 .BevelTopInset = 8.5
                 .BevelTopDepth = 5
                 .BevelBottomType = msoBevelArtDeco
                 .BevelBottomInset = 7
                 .BevelTopDepth = 6
           End With
    End With
End Sub

weiyingde

下面的代码，半是分享，半是完善，请大侠帮助实现，要求见附件。
Private Sub 生词处理(sht As Worksheet, r1 As Integer, c1 As Integer)
'参数说明:
'  sht：为指定工作表；
'  r1：为指定列数据的第一个数据所在的行数；
'  c1:为数据所在列的列数。
'  hs:输入到ppt中每张幻灯片的行数。
Dim arr, brr(), ro As Integer, rw As Integer
Dim dic As Object, regx As Object
Set dic = CreateObject("Scripting.Dictionary")
Set regx = CreateObject("vbscript.regexp")
regx.Global = True
regx.MultiLine = False
Set regex = CreateObject("vbscript.regexp")
regex.Global = True
regex.MultiLine = False
With sht
     For ro = .Cells(65536, c1).End(3).Row To 1 Step -1
          If Len(.Cells(ro, c1)) >= 20 Then .Cells(ro, c1).ClearContents
     Next
     rw = .Cells(65536, c1).End(3).Row
     arr = .Range(.Cells(r1, c1), .Cells(rw, c1))
End With
     For i = 1 To UBound(arr)
         isr = arr(i, 1)
         regx.Pattern = "\(.+\)"
         sr1 = regx.Replace(isr, "(" & Space(4) & ")")
         regex.Pattern = "\(.+\)"
         For Each mt In regx.Execute(isr)
             sr = Mid(mt, 2, Len(mt) - 2)
             ssr = ssr & IIf(Len(sr) <> 0, sr & Space(2), sr)
         Next
         dic(sr1) = ssr
         ssr = ""
     Next
     ky = dic.keys
     tm = dic.Items
For i = 1 To UBound(arr)
    n = n + 1
    ReDim Preserve brr(1 To 3, 1 To n)
         brr(1, i) = arr(i, 1)
         brr(2, i) = ky(i - 1)
         brr(3, i) = tm(i - 1)
Next
    brr = Application.WorksheetFunction.Transpose(brr)
    sht.[e7].Resize(UBound(brr), UBound(brr, 2)) = brr
End Sub

Sub tt()
Call 生词处理(ActiveSheet, 7, 3)
End Sub

weiyingde

weiyingde 发表于 2019-10-5 13:58
下面的代码，半是分享，半是完善，请大侠帮助实现，要求见附件。
Private Sub 生词处理(sht As Worksheet, ...

自我解决问题：.Pattern="\([^\(]+\)"
可以了，喝茶去。

microyip

weiyingde 发表于 2019-10-3 20:27
带参数的过程，相当于函数。可以反复调用。
Public Sub 输出(sht As Worksheet, r1 As Integer, c1 As Int ...

1. Public Sub 输出(sht As Worksheet, r1 As Integer, c1 As Integer, Num As Integer, Optional istr As String)

复制代码

最好写成

1. Public Sub 输出(Byval sht As Worksheet,Byval  r1 As Integer,Byval  c1 As Integer,Byval  Num As Integer, Optional Byval istr As String)

复制代码

以免因为过程中有对原值操作引起原值的变化，参考代码

1. Sub a()
   
2.     Dim e As Integer
   
3.     e = 1
   
4.     b e
   
5.     MsgBox "e值有原来的是1，现在还是" & e
   
6.     c e
   
7.     MsgBox "e值有原来的是1，现在变成" & e
   
8.     f e
   
9.     MsgBox "e值有原来的是2，现在变成" & e
   
10. End Sub
    
11. Sub b(ByVal d As Integer)
    
12.     d = d + 1
    
13. End Sub
    
14. Sub c(d As Integer)
    
15.     d = d + 1
    
16. End Sub
    
17. Sub f(ByRef d As Integer)
    
18.     d = d + 1
    
19. End Sub

复制代码

weiyingde

microyip 发表于 2019-10-5 14:15
最好写成以免因为过程中有对原值操作引起原值的变化，参考代码

谢谢指教，还有其他的疏漏吗，请指出。

microyip

weiyingde 发表于 2019-10-5 14:25
谢谢指教，还有其他的疏漏吗，请指出。

哪敢指教你，只是顺便胡言乱语一轮而已

weiyingde

microyip 发表于 2019-10-5 15:13
哪敢指教你，只是顺便胡言乱语一轮而已

还要多跟你学数组和字典的联合作战。希望不吝赐教

weiyingde

我没有什么理论基础，只是以解决眼前问题为导向，瞎闯乱打，知识层面上，只能在大虾面前称小白。以后问道幼稚的问题时，希望大侠不要嗤笑和嫌弃。