Home Php C# Sql C C++ Javascript Python Java Go Android Git Linux Asp.net Django .net Node.js Ios Xcode Cocoa Iphone Mysql Tomcat Mongodb Bash Objective-c Scala Visual-studio Apache Elasticsearch Jar Eclipse Jquery Ruby-on-rails Ruby Rubygems Android-studio Spring Lua Sqlite Emacs Ubuntu Perl Docker Swift Amazon-web-services Svn Html Ajax Xml Java-ee Maven Intellij-idea Rvm Macos Unix Css Ipad Postgresql Css3 Json Windows-server Vue.js Typescript Oracle Hibernate Internet-explorer Github Tensorflow Laravel Symfony Redis Html5 Google-app-engine Nginx Firefox Sqlalchemy Lucene Erlang Flask Vim Solr Webview Facebook Zend-framework Virtualenv Nosql Ide Twitter Safari Flutter Bundle Phonegap Centos Sphinx Actionscript Tornado Register | Login | Edit Tags | New Questions | 繁体 | 简体


10 questions online user: 51

0
votes
answers
22 views
+10

如何整合來自工作表Sheet1(供應商)的信息,掌握工作表Sheet1和Sheet2的(供應商),以MasterSheet2

-2

我用VBA工作(用於Excel宏)如何整合來自工作表Sheet1(供應商)的信息,掌握工作表Sheet1和Sheet2的(供應商),以MasterSheet2

在試圖複製SupplierFile1,File2(sheet2)Masterfile(Sheet2)

使用迪爾後訪問供應商文件,然後複製Sheet2中的數據我這樣做

ActiveWorkbook.Worksheets("Sheet2").Activate 
erow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row 
ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range(Cells(erow, 1), 

Cells(erow, 5)) //"This part is showing error" 

我不是一個程序員,並試圖在網上和YouTube,但沒有什麼工作的解決方案。

+0

什麼錯誤顯示?你忘了提到這一點。 – ADyson

+0

請閱讀[在什麼情況下我可以添加「緊急」或其他類似的短語到我的問題,以獲得更快的答案?](/ meta.stackoverflow.com/q/326569) - 總結是,這不是這是解決志願者問題的理想方式,可能會對獲得答案產生反作用。請不要將這添加到您的問題。 – halfer

沙发
0
0

我不知道你想與做的:

Cells(erow, 5)) //"This part is showing error" 

但卻有太多的括號。它應該是

Cells(erow, 5) 'Something else needs to go here 

嘗試這樣的事情

With ActiveSheet 
    .Range(.Cells(erow, 5).Select 'or whatever you're wanting to do 
End With 
0
votes
answers
23 views
+10

Excel VBA選擇選項網站下拉列表

0

我想使用VBA excel自動化該網站。我被困在一個點,我需要從下拉框中選擇值。我對此非常陌生,因爲這是我的第一個這樣的項目。 這是我的編碼選擇相應的值:Excel VBA選擇選項網站下拉列表

Set objSelect = objIE.document.getElementById("personTitle") 

For Each opt In objSelect.Options 
If opt.Value = "Miss" Then 
    'Debug.Print "found!" 

    opt.Selected = True 
    'opt.Selected = "selected" 
Else 
    'Debug.Print "not found!" 

    opt.Selected = False 
End If 
Next 

我已經使用debug.print檢查,如果我試圖找到值實際上得到匹配的身分─也試圖和原來它匹配。 我面臨的唯一問題是價值沒有得到確定。 任何大師可以幫忙嗎?

下面是部分的HTML:

<div class="input-wrap input-wrap__inline"> 
 

 
      <div tabindex="-1" class="select is-placeholder"><div class="select_display">Title</div><div class="select_arrow glyphicon glyphicon-chevron-down"></div><dl class="select_list"><dt class="pretend-dd is-hover" data-index="1" data-val="Mr">Mr</dt><dt class="pretend-dd" data-index="2" data-val="Mrs">Mrs</dt><dt class="pretend-dd" data-index="3" data-val="Miss">Miss</dt><dt class="pretend-dd" data-index="4" data-val="Ms">Ms</dt><dt class="pretend-dd" data-index="5" data-val="Dr">Dr</dt></dl></div><select name="personTitle" class="parsley-validated hasCustomSelect .no-change, .bv-dropdown-select is-invisible" id="personTitle" required="" data-required-message="Please select a title"> 
 
       <option selected="selected" value="">Title</option> 
 
       <option value="Mr">Mr</option> 
 
       <option value="Mrs">Mrs</option> 
 
       <option value="Miss">Miss</option> 
 
       <option value="Ms">Ms</option> 
 
       <option value="Dr">Dr</option> 
 
      </select> 
 

 
    </div>

沙发
0
0

這裏有幾個選項來嘗試,如果你還沒有:

If opt.Value = "Miss" Then 
'Debug.Print "found!" 
opt.Click 

OR

If opt.Value = "Miss" Then 
'Debug.Print "found!" 
opt.Focus 
opt.FireEvent ("onchange") 

如果事實證明這是在kendoGrid或kendoDropDownList中完成的事情,那麼我也可以幫助解決這個問題。

0
votes
answers
25 views
+10

Outlook VBA代碼不適用於所有電子郵件地址

0

我有一段簡短的代碼,在我發送電子郵件時運行。它會查看收件人地址和主題以查看它是否包含某些單詞,然後彈出消息框提醒我們更新繪圖版本控制。它適用於內部電子郵件地址,似乎在某些外部電子郵件地址上工作,但出於某種原因,它不喜歡我實際需要它留意的電子郵件地址。Outlook VBA代碼不適用於所有電子郵件地址

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean) 
Dim hismail As String 
Dim strSubject As String 
strSubject = Item.Subject 

Dim olObj As MailItem 


Set olObj = Application.ActiveInspector.CurrentItem 
hismail = olObj.Recipients.Item(1).AddressEntry.GetExchangeUser.PrimarySmtpAddress 
Set olObj = Nothing 

If hismail = "[email protected]" And strSubject Like "*update*" Or strSubject Like "*revision*" Then 


    MsgBox "Dont forget to update Drawing PDF`s if necessary", vbExclamation, "Have you updated the PDF`s?" 


End If 
End Sub 

我已將地址更改爲帖子,但其格式和長度相同。如果任何人有任何想法,我真的很感激它,如我們的供應商誰擁有一個郵箱充滿測試電子郵件和垃圾圖片。

感謝

+1

你能澄清一下究竟發生了什麼嗎?它只是不認識電子郵件,還是它給你一個錯誤?你有沒有試過測試你的'hisemail',以確保它獲得了你從他的電子郵件期望的地址?我會建議編寫一個簡單的腳本來專門打印他的電子郵件,以便您能夠看到代碼所看到的內容。 –

+1

此外,只是一個想法,他的電子郵件可能不在Exchange服務器內,因此您無法以這種方式獲得他的'PrimarySmtpAddress'。這可能就是你的大部分內部電子郵件和一些外部電子郵件正在工作的原因。請嘗試訪問「到」字段。或者看看你是否可以從另一個房產獲得他的電子郵件。 –

+0

嗨,對不起,沒有錯誤消息。電子郵件只是發送出去,顯示消息框。我只是嘗試將hismail發送到消息框。它在我的電子郵件地址上正常工作,並返回了正確的地址,但我試圖發送的地址想出了一個調試框,指出「運行時錯誤91:對象變量或塊變量未設置」adn debug突出顯示此行hismail = olObj.Recipients.Item(1).AddressEntry.GetExchangeUser.PrimarySmtpAddress – mike

沙发
0
0

後挖我的一點點找到了解決辦法,應該讓你指出正確的方向。這是基於懷疑您的問題是由於您的目標用戶在您的組織的Exchange服務器中不可用導致的。這個解決方案應該解決這個問題,但如果它不,它至少會讓你知道下一步的位置。

首先,我把代碼示例從這個MSDN文章(https://msdn.microsoft.com/en-us/VBA/Outlook-VBA/articles/obtain-the-e-mail-address-of-a-recipient),並修改它,讓它返回地址用戶和他們的電子郵件的數組:

Private Const PR_SMTP_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E" 

Private Function GetSMTPAddressesForRecipients(ByVal MailItem As Outlook.MailItem) As Variant 
    Dim Recipients As Outlook.Recipients 
    Set Recipients = MailItem.Recipients 

    Dim Addresses As Variant 
    ReDim Addresses(0 To Recipients.Count - 1, 0 To 1) 

    Dim Accessor As Outlook.PropertyAccessor 

    Dim Recipient As Outlook.Recipient 
    For Each Recipient In Recipients 
     Set Accessor = Recipient.PropertyAccessor 

     Dim i As Long 
     Addresses(i, 0) = Recipient.Name 
     Addresses(i, 1) = Accessor.GetProperty(PR_SMTP_ADDRESS) 

     i = i + 1 
    Next 

    GetSMTPAddressesForRecipients = Addresses 
End Function 

通過電子郵件中的所有收件人這將循環,並捕獲他們的姓名和電子郵件,將每個人放入陣列中的下一個位置。接下來,我們需要在日常工作中使用這些信息:

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean) 
    ' Note that I explicitly convert the subject to lowercase since the patterns use lowercase 
    Dim EmailSubject As String 
    EmailSubject = LCase(Item.Subject) 

    If EmailSubject Like "*update*" Or EmailSubject Like "*revision*" Then 
     Dim Addresses As Variant 
     Addresses = GetSMTPAddressesForRecipients(Item) 

     Dim i As Long 
     For i = LBound(Addresses, 1) To UBound(Addresses, 1) 
      If Addresses(i, 1) = "[email protected]" Then 
       MsgBox "Dont forget to update Drawing PDF`s if necessary", vbExclamation, "Have you updated the PDF`s?" 
       Exit For 
      End If 
     Next 
    End If 
End Sub 

有幾件事要注意。首先,您的模式使用的是小寫字母,因此您需要將主題轉換爲小寫字母,因此,如果您有像「更新版本」這樣的主題,您的模式仍然會捕獲該主題。其次,我把最可能的情況放在前面,也就是說,你的大多數電子郵件主題不會包含「主題」或「修訂」。然後無需向服務器詢問收件人的地址。以前,您的代碼會在檢查它是否需要它之前獲取地址。最好只要求我們需要的東西,它使您的代碼更易於閱讀和維護,同時還可以降低任何處理成本。

最後,這段代碼將循環通過全部地址,而不只是看第一個。通過這樣做,即使他是列表中的第二個,第三個或第五十個地址,您仍然會觸發警報。

我希望這有助於!以下是完整的代碼:

Option Explicit 

Private Const PR_SMTP_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E" 

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean) 
    ' Note that I explicitly convert the subject to lowercase since the patterns use lowercase 
    Dim EmailSubject As String 
    EmailSubject = LCase(Item.Subject) 

    If EmailSubject Like "*update*" Or EmailSubject Like "*revision*" Then 
     Dim Addresses As Variant 
     Addresses = GetSMTPAddressesForRecipients(Item) 

     Dim i As Long 
     For i = LBound(Addresses, 1) To UBound(Addresses, 1) 
      If Addresses(i, 1) = "[email protected]" Then 
       MsgBox "Dont forget to update Drawing PDF`s if necessary", vbExclamation, "Have you updated the PDF`s?" 
       Exit For 
      End If 
     Next 
    End If 
End Sub 

Private Function GetSMTPAddressesForRecipients(ByVal MailItem As Outlook.MailItem) As Variant 
    Dim Recipients As Outlook.Recipients 
    Set Recipients = MailItem.Recipients 

    Dim Addresses As Variant 
    ReDim Addresses(0 To Recipients.Count - 1, 0 To 1) 

    Dim Accessor As Outlook.PropertyAccessor 

    Dim Recipient As Outlook.Recipient 
    For Each Recipient In Recipients 
     Set Accessor = Recipient.PropertyAccessor 

     Dim i As Long 
     Addresses(i, 0) = Recipient.Name 
     Addresses(i, 1) = Accessor.GetProperty(PR_SMTP_ADDRESS) 

     i = i + 1 
    Next 

    GetSMTPAddressesForRecipients = Addresses 
End Function 
+0

真是太棒了。您確定了問題,重新編寫了代碼(以及它的工作原理),完整的解釋和信息加載。這太棒了,非常感謝你 – mike

+0

不是一個問題,它是我們在這裏。祝你好運! :) –

0
votes
answers
15 views
+10

EXCEL IF聲明?

-1

我正在用excel製作一個訂單列表,並帶有f.e.付款日期,訂單日期,發貨日期,價格,交貨日期等等。我想要填寫一個「已完成」欄,當物品到達並且付款等完成時自動獲得值「1」或「是」,因此當一切都充滿了。這可能嗎?EXCEL IF聲明?

謝謝!

沙发
0
0

隨着列一個數據通過中號,在N1輸入:

=IF(COUNTA(A1:M1)=COLUMNS(A1:M1),1,0) 

這種類型的公式的優點是,它會自動調整,如果你添加/刪除列。

+0

我想這是「計數」ISO「計數」,但是當我輸入任一這說它有一個公式錯誤。 –

+0

@EwoutSchokker我的公式使用**英文**函數名稱..........您的Excel版本使用哪種語言? –

+0

哦,它的在線谷歌電子表格。語言是荷蘭語。 –

板凳
0
0

您可能會使用類似這樣的內容,如果列B中的值符合您的條件,它將自動在目標偏移列中輸入「yes」。根據您的要求進行調整。

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 

If Target.Cells.Count > 1 Then Exit Sub 

    If Not Intersect(Target, Range("B2:B305")) Is Nothing Then 

      If Target = vbNullString Then 

       Target = "payment made" 'or whatever you want to use 
       Target.Offset(0, 12) = "Yes" 'which would be column N 
      Else 

       Target = vbNullString 'if the value in column B is removed 
       Target.Offset(0, 12) = vbNullString 'column N is reutrned to blank 

      End If 

    End If 
End Sub 
0
votes
answers
37 views
+10

使用Items.find查找Item.index

0

如何查找使用items.find方法設置的聯繫人項目的索引?找到物品後,我希望能夠移動到下一個物品,但我的代碼將我發送到集合中的第一個物品。我的計劃的一個濃縮版本低於...使用Items.find查找Item.index

dim ColItms as items 
dim CI as contactItem 
Dim CIindex as integer 

set CI= ColItms.find("[CompanyName] = ""IBM""") 
CIindex = CI.???? ''''' This shows what I'm wanting to do, but don't know how 

' now advance to next item in collection 
set ci = ColItms.item(CIindex +1) ' i think this would work if I could find CIindex 

set ci = ColItms.GetNext ' this fails as it returns the 1st item in the collection 

現在一切似乎工作是遍歷集合中的每個項目,看它是否找到聯繫人匹配,

沙发
0
0

項目沒有內在指標,只有一個條目id。 要查找下一場比賽,請使用Items.FindNext

0
votes
answers
16 views
+10

使用通配符創建搜索

0

我希望能夠使用通配符搜索兩個搜索字段。使用通配符創建搜索

例如:我有一個搜索字段,可以搜索水果。我希望能夠放入「應用程序」或「通道」,並將結果提供給我。

我看過的大部分代碼只有在你知道要搜索什麼的時候纔有效,但是我的字符串總是會改變的。

這是下面的代碼搜索水果,但匹配它。

sheet.Select 
finalrow = Cells(Rows.Count, 1).End(xlUp).Row 


For i = 1 To finalrow 
    If IIf(fruit <> "", Cells(i, 1) = fruit, True) Then 
    Range(Cells(i, 1), Cells(i, 8)).Copy 
    ssheet.Range("A100").End(xlUp).Offset(1, 0).Resize(1, 8).Value = 
    Range(Cells(i, 1), Cells(i, 8)).Value 

    dsheet.Select 

    End If 
Next i 
沙发
0
0

當只做一個,你不需要你最後一個問題的IIF。

您不需要複製行。並避免選擇。

finalrow = dsheet.Cells(Rows.Count, 1).End(xlUp).Row 


For i = 1 To finalrow 
    If fruit = "" Or InStr(dsheet.Cells(i, 1),fruit) > 0 Then 
     ssheet.Range("A100").End(xlUp).Offset(1, 0).Resize(1, 8).Value = dsheet.Range(dsheet.Cells(i, 1), dsheet.Cells(i, 8)).Value 
    End If 
Next i 

如果你想在IIF,因爲你簡化了它這樣一個問題:

If IIf(fruit <> "", InStr(dsheet.Cells(i, 1),fruit) > 0, True) Then 
+0

你好,這樣會令水果是外卡?所以如果我輸入「ap」,我會得到蘋果杏等等? – Tara

+0

是如果找到該零件,則Instr將返回大於'0'的數字。 –

+0

工程太棒了!再次感謝你的幫助! – Tara

0
votes
answers
25 views
+10

此代碼的哪一部分提供了用於選擇項目的msg框

-1

我付了一個人來幫助我編寫一個宏來填充電子表格中的表。我覺得我通常可以理解一些編寫的代碼,但這超出了我的想法。我只是想學習如何爲自己做這件事。此代碼的哪一部分提供了用於選擇項目的msg框

Option Explicit 
Option Base 1 
Dim s_no() As String 
Sub createReport() 
start_win.Show 
End Sub 



Sub ook() 


Dim last As Integer 

ReDim s_no(1 To 1) 

If Not Sheet1.Range("A2").Value = "" Then 
    s_no(1) = Sheet1.Range("A2").Value 
Else 
    MsgBox "Empty sheet" 
End If 

last = Cells(Sheet1.Rows.Count, 1).End(xlUp).Row 
Dim i As Integer 
For i = 2 To last 
    If already_exists(Sheet1.Range("A" & CStr(i)).Value) = False Then 
     ReDim Preserve s_no(1 To UBound(s_no) + 1) 
     s_no(UBound(s_no)) = Sheet1.Range("A" & CStr(i)).Value 
    End If 
Next 

For i = 1 To UBound(s_no) 
    Debug.Print s_no(i) 
Next 
End Sub 

Function already_exists(trial) 
already_exists = False 
Dim i As Integer 
For i = 1 To UBound(s_no) 
    If s_no(i) = trial Then 
     already_exists = True 
     Exit Function 
    End If 
Next 
End Function 
+1

只有一個部分打開了一個消息框,在這裏是「MsgBox」Empty sheet「,你可以在你需要幫助的地方添加更多信息嗎? –

+0

你可能需要發佈'start_win'的代碼, – YowE3K

沙发
0
-2

正如@ Yow32K表明,它似乎有一個自定義窗體「start_win」是誰幫助你的人創建的。

start_win.Show將是實際提出這種形式的線。

+0

非常感謝你提供寶貴意見,我很抱歉花了這麼長時間才這麼說。 – Gilmer

板凳
0
0

你付錢給誰寫的?我會索要我的錢。
如果您提供start_win表格中的代碼,我可以將其拆分爲如果需要。

我已在每行解釋中添加了註釋。

Option Explicit     'All variables must be declared first. 
Option Base 1     'Arrays start at 1 rather than 0. 
Dim s_no() As String   'Global array variable. 
           'Available to all procedures in the module. 

Sub createReport() 
start_win.Show     'Open and display a form called `start_win`. 
           'Form will likely contain code as well. 
End Sub 



Sub ook()      'Reference to disc-worlds librarian? 
           '(and the name of this procedure) 


Dim last As Integer    'The 'last' variable will hold values between 
           '–32,768 to 32,767. 
           'Terrible for holding row numbers. 

ReDim s_no(1 To 1)    'The global variable is reassigned as an 
           'array containing 1 element. 

If Not Sheet1.Range("A2").Value = "" Then 'Sheet1 is the sheet codename 
              '(name not in brackets in Project explorer). 
              'If cell A2 is an empty string then go to 
              'next line, otherwise message box. 

    s_no(1) = Sheet1.Range("A2").Value  'Place value from A2 into "s_no(1)" 
              'element of variable. 
Else 
    MsgBox "Empty sheet"     'If cell A2 was an empty string then 
              'jump to this line. 
End If 

last = Cells(Sheet1.Rows.Count, 1).End(xlUp).Row 'Get the last row number from the 
                'sheet with codename Sheet1 and 
                'store in 'last' variable. 
                'Didn't I say that was a terrible idea? 
                'This line will fail if the last 
                'row is >32,767 (Overflow error). 

Dim i As Integer         'Again, terrible idea - integer for row 
                'numbers... no. Use LONG instead. 

For i = 2 To last         'Step from row 2 to last row 
                '(providing error hasn't happened). 

    If already_exists(Sheet1.Range("A" & CStr(i)).Value) = False Then 'Pass the value from 
                     'row number 'i' in column A 
                     'to the 'already_exists' procedure 
                     'where it will be called 'trial' 
                     '"Sheet1.Cells(i,2)" would be better. 

     ReDim Preserve s_no(1 To UBound(s_no) + 1)      'Increase the size of the 's_no' 
                     'array while keeping an values it 
                     'already holds. 

     s_no(UBound(s_no)) = Sheet1.Range("A" & CStr(i)).Value   'Place the value from column A 
                     'in the array. 
    End If 
Next 

For i = 1 To UBound(s_no) 'Cycle through the array. 
    Debug.Print s_no(i)  'Place the value from the array in the immediate window. 
Next 
End Sub 

Function already_exists(trial)  'Function to return a variant value 
            '(should specify the return type). 

already_exists = False    'Start as False.. so it's a boolean. 
            'Be better to declare that in the function name. 

Dim i As Integer     'There's that integer again. Just stop... 

For i = 1 To UBound(s_no)   'Cycle through each element in 's_no' array. 

    If s_no(i) = trial Then   'Does that element equal the one passed 
            'from the main procedure? 

     already_exists = True  'If it does then return TRUE to the main procedure. 

     Exit Function    'Exit the function and jump back to the main procedure. 
            'Would be the better to exit the loop and have one 
            'exit point for the function. 
    End If 
Next 
End Function 

編輯:
作爲這個後續就是我怎麼會寫在ook程序,並廢除了already_exists功能。

Sub ook() 

    Dim lLast As Long  'Holds last row number. 
    Dim i As Long   'Holds current row number. 
    Dim s_no As Object  'Define an object. 
    Dim key As Variant  'Use this to step through the populated dictionary. 

    Set s_no = CreateObject("Scripting.Dictionary") 'Define it as a dictionary. 

    With Sheet1 
     lLast = .Cells(.Rows.Count, 1).End(xlUp).Row 

     'Previously assumed that A2 would hold a value, 
     'so if last row in column A is 1 then A2 will be blank 
     'and the sheet is empty. 
     If lLast <> 1 Then 

      For i = 2 To lLast 
       'Does the value already exist in the dictionary object? 
       If Not s_no.exists(.Cells(i, 1).Value) Then 
        s_no.Add .Cells(i, 1).Value, .Cells(i, 1).Value 'It doesn't, so add it. 
       End If 
      Next i 

      For Each key In s_no 
       Debug.Print s_no(key) 
      Next key 

     Else 
      'Nothing else should happen if the sheet is empty. 
      MsgBox "Empty sheet", vbCritical + vbOKOnly 

     End If 
    End With 

End Sub 

另一個編輯:Dictionaries - 對不起,通常不鏈接這個網站之外,但它是一個很好的教程。

0
votes
answers
41 views
+10

啓動後可以將EC2實例設置爲打開文件嗎?

0

我的工作流程通常包括啓動一組EC2服務器,並讓它們在Excel工作簿的不同部分上工作。它不理想,但它是如何。我想盡可能自動化這個過程。啓動後可以將EC2實例設置爲打開文件嗎?

理想情況下,我會在啓動時創建一個打開Excel工作簿的AMI。然後,該工作簿將自動運行一個腳本,該腳本從保管箱文件夾中獲取已命名的Excel工作簿,打開該工作簿並運行其自動腳本。這樣我所要做的就是編寫第二個Excel工作簿的腳本,給它一個「魔術」名稱,將它上傳到保管箱,並在第一個工作簿中啓動適當數量的AMi實例,並在工作已完成並上傳到保管箱文件夾。

我知道如何做到這一點,除了啓動EC2實例後打開「bootstrap」Excel文件。這可能嗎?

沙发
0
0

創建一個ami,在啓動時調用aws服務器設置作爲控制器。由於您從ami啓動的許多實例都會調用控制器並請求工作。

+1

如果工作事先知道,它可能是最好把工作項目上的SQS隊列,並讓每個EC2實例從隊列中提取的項目。 – jarmod

板凳
0
2

當您啓動您提供userdata的EC2實例時。該用戶數據可以是在實例啓動時自動運行的腳本。

另一種替代方法是使用EC2 Systems Manager Run Command在啓動後在EC2實例上遠程調用操作/腳本 - 您可以輕鬆自動執行某些操作以啓動實例,等待其準備就緒,然後使用某些動態參數遠程調用Excel腳本。

另一種方法是放置在不SQS隊列中的工作項目,然後使用用戶數據的想法運行在實例啓動一個腳本,從隊列中拉項目,做的工作。

另一個想法是使用AWS Lambda。只需將工作簿上傳到S3,並觸發一個Lambda函數。這既可以讀取和處理整個工作簿,或者如果你真的需要的工作簿的部分由不同的任務來處理,那麼你的lambda函數可以調用一些下屬lambda函數和扇出工作簿給他們的部分。

地板
0
0

您可以創建一個窗口服務/任務,並在啓動時執行一個bat文件。 bat文件將打開運行腳本的excel文件。

我覺得這個方法可能比使用AWS服務簡單。

0
votes
answers
33 views
+10

用戶窗體基於企業價值識別正確的工作表

0

我有一個工作簿,其中包含客戶端信息。每個客戶都有一張工作表,每張工作表都標有客戶的唯一ID。我想要啓動一個UserForm,用戶將從cobo box中選擇一個客戶端。然後,來自相應工作表最後一行的數據填充UserForm。用戶窗體基於企業價值識別正確的工作表

在同一工作簿中的其他代碼中,我使用的是腳本字典,但這些字典都與特定工作表中的特定範圍相關聯。我不知道如何編寫UserForm以在所有工作表中搜索與cobo_ClientID字段中的值相同的名稱,然後從MAX行更新日期的行中引入正確的數據元素。

下面是我一直在使用在其他領域的腳本辭典的例子:

Set coboDict = CreateObject("Scripting.Dictionary") 
With coboDict 
    For Each cStatsClientID In ws1.Range("StatsClientID") 
     If Not .exists(cStatsClientID.Value) Then 
      .Add cStatsClientID.Value, cStatsClientID.Row 
     Else 
      If CLng(cStatsClientID.Offset(, -2).Value) > CLng(ws1.Range("B" & .Item(cStatsClientID.Value))) Then 
      .Item(cStatsClientID.Value) = cStatsClientID.Row 
      End If 
     End If 
    Next cStatsClientID 
    Me.cobo_ClientID.List = Application.Transpose(.keys) 
    End With 
+0

您是否可以不使用Worksheet.Name屬性來獲取正確的工作表,然後使用[lastRow](https://www.rondebruin.nl/win/s9/win005.htm)計算來檢索最後一行? – QHarr

+0

說實話,我不確定,因爲我對VBA還比較陌生,以前沒有使用過這個屬性。在查看時,我不確定它是如何讓我A - 根據cobo_ClientID或B的值識別正確的表格 - 能夠從正確的表格中找到值MAX更新日期。 – Rodger

+0

每個客戶工作表的名稱與客戶ID相同。因此,如果有3個客戶端的ID分別爲「RB1」,「RB2」和「QJ4」,則有3個客戶端工作表,分別命名爲「RB1」,「RB2」和「QJ4」。我已經能夠獲得代碼來識別正確的工作表,但仍然無法從最後一行獲取表單中的單元格中的數據。 – Rodger

沙发
0
0

從另一個論壇時提供的LASTROW鏈接,以及一些建議之間,我覺得我有解決方案。這個問題似乎與我如何設置LastRow以及找到正確的表單有關。

Private Sub cobo_ClientID_Change() 

Dim Sht As String 
Dim LastRow As Long 

Sht = Me.cobo_ClientID 

With ActiveSheet 
LastRow = .Cells(.Rows.Count, "E").End(xlUp).Row 
End With 

txt_Name = Sheets(Sht).Range("E" & LastRow).Value 
txt_DPPymtAmt = Sheets(Sht).Range("H" & LastRow).Value 

End Sub 
板凳
0
0

此代碼將查看每個工作表名稱並在組合框中列出它們。當您選擇其中一張工作表時,它將採用最後一行的值並將它們放置在表格上的文本框中。

添加這些控件到窗體:

  • 組合框稱爲命名txtColAtxtColBtxtColCcmbSheets
  • 三個文本框。

-

Private Sub UserForm_Initialize() 

    Dim wrkSht As Worksheet 

    'Populate the combo-box with sheet names. 
    For Each wrkSht In ThisWorkbook.Worksheets 
     With Me.cmbSheets 
      .AddItem wrkSht.Name 
     End With 
    Next wrkSht 

End Sub 


'Will place the values from the last row columns A:C in textboxes on the form. 
Private Sub cmbSheets_Change() 
    Dim rLastCell As Range 
    Dim shtSelected As Worksheet 

    'Set a reference to the sheet selected by the combo box. 
    Set shtSelected = ThisWorkbook.Worksheets(cmbSheets.Value) 

    Set rLastCell = LastCell(shtSelected) 

    With shtSelected 
     Me.txtColA = .Cells(rLastCell.Row, 1) 
     Me.txtColB = .Cells(rLastCell.Row, 2) 
     Me.txtColC = .Cells(rLastCell.Row, 3) 
    End With 
End Sub 

'This function can be placed in a normal module. 
'Finds the last cell given a worksheet reference. 
Public Function LastCell(wrkSht As Worksheet) As Range 

    Dim lLastCol As Long, lLastRow As Long 

    On Error Resume Next 

    With wrkSht 
     lLastCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column 
     lLastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row 

     If lLastCol = 0 Then lLastCol = 1 
     If lLastRow = 0 Then lLastRow = 1 

     Set LastCell = wrkSht.Cells(lLastRow, lLastCol) 
    End With 
    On Error GoTo 0 

End Function 

注 -如果任何一個值,需要特定的格式化然後應該複印時使用該命令FORMAT被添加。
E.g.如果一個單元格的日期爲2016年5月1日的01/05/2016,那麼它將在文本框中顯示爲5/1/2016(轉換爲美國日期格式)。
使用代碼Me.txtColC = Format(.Cells(rLastCell.Row, 3), "dd-mmm-yy")將在窗體上顯示日期爲01-May-16
同樣的貨幣應該被添加爲Me.txtColB = Format(.Cells(rLastCell.Row, 2), "Currency")否則£15將顯示爲。

如果你想排除某些表看看SELECT CASE...END SELECT代碼塊(或IF...ELSE...END IF

如果你想在片改變爲您在組合框中選擇不同的值,只是增加shtSelected.Select到的結束cmbSheets_Change()事件。

0
votes
answers
59 views
+10

我刮板拋出錯誤,而不是當一切都做

10

我已經寫在VBA刮刀解析從洪流站點的某些影片信息退出瀏覽器。我用IEqueryselector完成任務。當我執行我的代碼時,它會解析一切,並彈出一個錯誤。看起來這個錯誤似乎是無處不在,而不是繼續。如果我取消錯誤框,那麼我可以看到結果。我已經上傳了兩張圖片,向您展示我遇到的錯誤。我如何成功執行代碼而不會出現任何錯誤?提前致謝。我刮板拋出錯誤,而不是當一切都做

下面是完整的代碼:

Sub Torrent_Data() 
    Dim IE As New InternetExplorer, html As HTMLDocument 
    Dim post As Object 

    With IE 
     .Visible = False 
     .navigate "https://yts.am/browse-movies" 
     Do While .readyState <> READYSTATE_COMPLETE: Loop 
     Set html = .Document 
    End With 

    For Each post In html.querySelectorAll(".browse-movie-bottom") 
     Row = Row + 1: Cells(Row, 1) = post.queryselector(".browse-movie-title").innerText 
     Cells(Row, 2) = post.queryselector(".browse-movie-year").innerText 
    Next post 
    IE.Quit 
End Sub 

時遇到的錯誤:

First error

Second error

錯誤的兩者都出現在同一時間。 我使用Internet Explorer 11

在另一方面,如果我嘗試喜歡它下面沒有問題,成功帶來的結果。

Sub Torrent_Data() 
    Dim IE As New InternetExplorer, html As HTMLDocument 
    Dim post As Object 

    With IE 
     .Visible = False 
     .navigate "https://yts.am/browse-movies" 
     Do While .readyState <> READYSTATE_COMPLETE: Loop 
     Set html = .Document 
    End With 

    For Each post In html.getElementsByClassName("browse-movie-bottom") 
     Row = Row + 1: Cells(Row, 1) = post.queryselector(".browse-movie-title").innerText 
     Cells(Row, 2) = post.queryselector(".browse-movie-year").innerText 
    Next post 
    IE.Quit 
End Sub 

參考我已經添加到庫中:

1. Microsoft Internet Controls 
2. Microsoft HTML Object Library 

那麼,什麼是錯的queryselector或什麼,我在這裏失蹤,使一個成功的去嗎?是否有任何參考添加到圖書館擺脫錯誤?

+0

快速檢查:不改變'queryselector'到'querySelector'使第一個代碼示例中有什麼區別? – alecxe

+0

不,先生,沒有任何改變。事實上,如果我嘗試編寫'querySelector',它會自動回到'queryselector'的小寫字母。 – SIM

+0

好吧,試試這個:直接執行'post.innerText',而不是執行'post.queryselector'。這不是你想要做的,但讓我們試驗。你看到同樣的錯誤?謝謝。 – alecxe

沙发
0
5

好了,也有一些是嚴重不友好有關的網頁。它一直在爲我崩潰。所以我已經採取在腳本引擎/腳本控制內運行JavaScript程序,它的工作原理。

我希望你能理解。該邏輯是在JavaScript中添加到ScriptEngine中的。我得到兩個節點列表,一個電影列表和一個年份列表;然後我逐步同步每個陣列並將它們作爲鍵值對添加到Microsoft Scripting Dictionary。

Option Explicit 

'*Tools->References 
'* Microsoft Scripting Runtime 
'* Microsoft Scripting Control 
'* Microsoft Internet Controls 
'* Microsoft HTML Object Library 

Sub Torrent_Data() 
    Dim row As Long 
    Dim IE As New InternetExplorer, html As HTMLDocument 
    Dim post As Object 

    With IE 
     .Visible = True 
     .navigate "https://yts.am/browse-movies" 
     Do While .readyState <> READYSTATE_COMPLETE: 
      DoEvents 
     Loop 
     Set html = .document 
    End With 

    Dim dicFilms As Scripting.Dictionary 
    Set dicFilms = New Scripting.Dictionary 

    Call GetScriptEngine.Run("getMovies", html, dicFilms) 

    Dim vFilms As Variant 
    vFilms = dicFilms.Keys 

    Dim vYears As Variant 
    vYears = dicFilms.Items 

    Dim lRowLoop As Long 
    For lRowLoop = 0 To dicFilms.Count - 1 

     Cells(lRowLoop + 1, 1) = vFilms(lRowLoop) 
     Cells(lRowLoop + 1, 2) = vYears(lRowLoop) 

    Next lRowLoop 

    Stop 

    IE.Quit 
End Sub 

Private Function GetScriptEngine() As ScriptControl 
    '* see code from this SO Q & A 
    ' https://stackoverflow.com/questions/37711073/in-excel-vba-on-windows-how-to-get-stringified-json-respresentation-instead-of 
    Static soScriptEngine As ScriptControl 
    If soScriptEngine Is Nothing Then 
     Set soScriptEngine = New ScriptControl 
     soScriptEngine.Language = "JScript" 

     soScriptEngine.AddCode "function getMovies(htmlDocument, microsoftDict) { " & _ 
            "var titles = htmlDocument.querySelectorAll('a.browse-movie-title'), i;" & _ 
            "var years = htmlDocument.querySelectorAll('div.browse-movie-year'), j;" & _ 
            "if (years.length === years.length) {" & _ 
            "for (i=0; i< years.length; ++i) {" & _ 
            " var film = titles[i].innerText;" & _ 
            " var year = years[i].innerText;" & _ 
            " microsoftDict.Add(film, year);" & _ 
            "}}}" 

    End If 
    Set GetScriptEngine = soScriptEngine 
End Function 
板凳
0
0

好吧,看來我找到了解決方案,與.queryselectorAll()一起工作。經過多次試驗後,我可以注意到它只與for loop有一些問題,所以我巧妙地避免了for loop,而是用with block來完成同樣的工作。以下是我們如何做到這一點:

Sub Torrent_Data() 

    With CreateObject("InternetExplorer.Application") 
     .Visible = False 
     .navigate "https://yts.am/browse-movies" 
     While .Busy = True Or .readyState < 4: DoEvents: Wend 

     With .document.querySelectorAll(".browse-movie-bottom") 
      For I = 0 To .Length - 1 
       Cells(I + 1, 1) = .Item(I).querySelector(".browse-movie-title").innerText 
       Cells(I + 1, 2) = .Item(I).querySelector(".browse-movie-year").innerText 
      Next I 
     End With 
    End With 

End Sub 

順便說一句,上述腳本可以在不引用任何內容的情況下執行。