-3
My Excel VBA 매크로가 Excel 스프레드 시트를 계속 충돌시킵니다. 여러 SMS 텍스트/전자 메일 또는 아마도 keyval
기능을 보내도록 Excel에 요청하기 때문일 수 있습니다. 변수 RAN에 대한Excel 2013이 계속 충돌 함
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim d As Integer
Dim e As Integer
Dim em As String
Dim st As String
Dim str As String
Dim em2 As String
Dim mon As Worksheet
Sub SingleButtonEvent()
Set mon = Sheets("MON")
st = ""
ActiveSheet.Unprotect
If ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row < 30 Then
a = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row
If mon.Cells(a, "BB") = "" Then
'MsgBox "No Number in Column BB. Message Will Not Send", vbCritical
Exit Sub
Else
em = mon.Cells(a, "BB").Value
With Cells(a, "AV").Font
.Color = RGB(166, 166, 166)
.Size = 12
End With
Call SendSMS
End If
Else
For b = 1 To 29
If Cells(b, "B") <> 0 Then
a = b
If mon.Cells(a, "BB") = "" Then
Else
em = mon.Cells(a, "BB").Value
Call SendSMS
End If
End If
Next
End If
ActiveSheet.Protect
End Sub
Sub SendSMS()
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Fields.Update
iMsg.To = em
'Change Bellow email to your email
iMsg.From = "[email protected]"
iMsg.Subject = ""
c = Cells(a, "A").End(xlToRight).Column
st = ""
em2 = ""
If c > 2 Then
'st = Format(Date, "DDDD") & "<br/>"
For d = 3 To c
If Cells(a, d) <> "" And CInt(Cells(30, d).Value) <= 7 Then
st = st & Cells(30, d).Value & ". " & Application.WorksheetFunction.Clean(Cells(a, d).Value) & " | " & Application.WorksheetFunction.Clean(Cells(a, d + 1).Value) & " | " & Application.WorksheetFunction.Clean(Cells(a, d + 2).Value) & "<br/>"
d = d + 2
ElseIf Cells(a, d) <> "" And CInt(Cells(30, d).Value) > 7 Then
If em2 = "" Then
em2 = Cells(30, d).Value & ". " & Application.WorksheetFunction.Clean(Cells(a, d).Value) & " | " & Application.WorksheetFunction.Clean(Cells(a, d + 1).Value) & " | " & Application.WorksheetFunction.Clean(Cells(a, d + 2).Value) & "<br/>"
d = d + 2
Else
em2 = em2 & Cells(30, d).Value & ". " & Application.WorksheetFunction.Clean(Cells(a, d).Value) & " | " & Application.WorksheetFunction.Clean(Cells(a, d + 1).Value) & " | " & Application.WorksheetFunction.Clean(Cells(a, d + 2).Value) & "<br/>"
d = d + 2
End If
Else
Exit Sub
End If
Next
End If
'If ActiveSheet.Name = "MON" Then
'str = Cells(a, "B").Value
'Else
'str = Cells(a, "B").Value
'End If
If em2 = "" Then
iMsg.HTMLBody = st & "Visa triet " & Cells(a, "AY").Value & "<br/>Total " & Cells(a, "B").Value & "<br/>"
Set iMsg.Configuration = iConf
iMsg.Send
Else
iMsg.HTMLBody = st
Set iMsg.Configuration = iConf
iMsg.Send
iMsg.HTMLBody = em2 & "Visa " & Cells(a, "AY").Value & "<br/>Total " & Cells(a, "B").Value & "<br/>"
Set iMsg.Configuration = iConf
iMsg.Send
End If
Set iMsg = Nothing
End Sub
Function KeyVal(ParamArray ran() As Variant)
Application.Volatile True
Dim str As String
a = 0
Do While a < UBound(ran) + 1
If ran(a) = 0 Or ran(a) = "" Then
a = a + 1
Else
b = Sheets("Key").Cells(Rows.Count, "A").End(xlUp).Row
str = ran(a)
If InStr(str, "/") > 0 Then
Do While InStr(str, "/") > 0
d = Application.WorksheetFunction.Search("/", str)
st = Mid(str, 1, d - 1)
str = Application.WorksheetFunction.Clean(Trim(Mid(str, d + 1, Len(str))))
For c = 1 To b
If LCase(st) = LCase(Sheets("Key").Cells(c, "A").Value) Then
KeyVal = KeyVal + Sheets("Key").Cells(c, "B").Value
End If
Next
If InStr(str, "/") <= 0 Then
For c = 1 To b
If str = Sheets("Key").Cells(c, "A").Value Then
KeyVal = KeyVal + Sheets("Key").Cells(c, "B").Value
End If
Next
End If
Loop
Else
For c = 1 To b
If ran(a) = Sheets("Key").Cells(c, "A").Value Then
KeyVal = KeyVal + Sheets("Key").Cells(c, "B").Value
End If
Next
End If
a = a + 1
End If
Loop
End Function
디버거에서 코드를 단계별로 실행하면 어떤 점이 알려 집니까? 충돌의 원인이되는 코드 줄은 무엇입니까? 우리는 여러분의 코드에 대한 기본적인 디버깅을하기 위해 여기에 온 것은 아닙니다. 문제의 원인이되는 코드 섹션을 추적하면 문제를보다 명확하게 설명하고 ** 특정 질문 **을 통해 답변을 얻을 수 있습니다. –