Использование программы Mystem , разбиение всех статей на отдельные слова в начальной форме, составление матрицы слов — КиберПедия 

Кормораздатчик мобильный электрифицированный: схема и процесс работы устройства...

Поперечные профили набережных и береговой полосы: На городских территориях берегоукрепление проектируют с учетом технических и экономических требований, но особое значение придают эстетическим...

Использование программы Mystem , разбиение всех статей на отдельные слова в начальной форме, составление матрицы слов



Sub RunMystem()

 FilePath = "C:\news\"

 

 For i = 1 To 110

 num = Trim(Str(i))

 fileIn = FilePath & "news" & num & ".txt"

 fileOut = FilePath & "news" & num & "_res.txt"

 params = "C:\mystem.exe -l -n -e win " + fileIn + " " + fileOut

 retVal = Shell(params, vbNormalFocus)

 Application.Wait (Now + TimeValue("0:00:02"))

 Next i

End Sub

-------------------------------------------------------------------

Sub AddAll()

For i = 1 To 110

AddFile (i)

Next i

End Sub

--------------------------------------------------------------------

Sub AddFile(N)

'

' Макрос1 Макрос

'

' Сочетание клавиш: Ctrl+Shift+A

'

num = Trim(Str(N))

   

With ActiveSheet.QueryTables.Add(Connection:= _

   "TEXT;C:\news\news" + num + "_res.txt", Destination:=Sheets("TABLE").Cells(1, N))

   .Name = "news" + num + "_res"

   .FieldNames = True

   .RowNumbers = False

   .FillAdjacentFormulas = False

   .PreserveFormatting = True

   .RefreshOnFileOpen = False

   .RefreshStyle = xlInsertDeleteCells

   .SavePassword = False

   .SaveData = True

   .AdjustColumnWidth = True

   .RefreshPeriod = 0

   .TextFilePromptOnRefresh = False

   .TextFilePlatform = 1251

   .TextFileStartRow = 1

   .TextFileParseType = xlDelimited

   .TextFileTextQualifier = xlTextQualifierDoubleQuote

   .TextFileConsecutiveDelimiter = False

   .TextFileTabDelimiter = True

   .TextFileSemicolonDelimiter = False

   .TextFileCommaDelimiter = False

   .TextFileSpaceDelimiter = False

   .TextFileColumnDataTypes = Array(1)

   .TextFileTrailingMinusNumbers = True

   .Refresh BackgroundQuery:=False

End With

End Sub

-------------------------------------------------------------------

Sub RemoveDuble()

For i = 1 To 110

ActiveSheet.Range(Cells(1, i), Cells(600, i)).RemoveDuplicates Columns:=1, Header:=xlYes

Next i

End Sub

---------------------------------------------------------------------

Sub Макрос2()

'

' Макрос2 Макрос

'

' Сочетание клавиш: Ctrl+Shift+V

'

For i = 1 To 110

Range(Cells(1, i), Cells(600, i)).Select

ActiveWorkbook.Worksheets("TABLE").Sort.SortFields.cLEAR

ActiveWorkbook.Worksheets("TABLE").Sort.SortFields.Add Key:=Range(Cells(1, i), Cells(1, i)), _

   SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

With ActiveWorkbook.Worksheets("TABLE").Sort

   .SetRange Range(Cells(1, i), Cells(600, i))

   .Header = xlNo

   .MatchCase = False

   .Orientation = xlTopToBottom

    .SortMethod = xlPinYin

   .Apply

End With

Next i

End Sub

---------------------------------------------------------------------

Sub AllWords()

k = 1

For i = 1 To 110

For j = 1 To 600

Worksheets("OMG").Cells(k, 1) = Worksheets("TABLE").Cells(j, i)

   k = k + 1

Next j

Next i

LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count

Application.ScreenUpdating = False

For j = LastRow To 1 Step -1

   If Application.CountA(Rows(j)) = 0 Then Rows(j).Delete

Next j

 

End Sub

--------------------------------------------------------------------

Public Sub LALA()

 

ActiveSheet.Range("$A$1:$A$17094").RemoveDuplicates Columns:=1, Header:=xlNo

ActiveSheet.Range("$A$1:$A$2990" & Cells(Rows.Count, 1).End(xlUp).Row).Sort Key1:=Range("A1"), _

Orientation:=xlTopToBottom

' после сделать сортировку от а до я вручную:)

End Sub

------------------------------------------------------------

3. Удаление дубликатов, удаление слов, встречающихся менее 7 раз, составление пар слов

Public Sub WORDS()

 

For i = 1 To 110

Worksheets("WORDS").Cells(1, i + 1).Value = i

Next i

For i = 2 To 2991

Worksheets("OMG").Cells(i - 1, 1).Copy Worksheets("WORDS").Cells(i, 1)

Next i

 

End Sub

---------------------------------------------------------------------

Public Sub Dell()

Dim i As Integer

 For i = 1 To 334

If Worksheets("WORDS").Cells(i, 112).Value <= 6 Then

Range(Cells(i, 1), Cells(i, 112)).Delete

End If

 Next i

End Sub

--------------------------------------------------------------------

Public Sub Pairs()

pair = 1

 For i = 2 To 281

 For j = i + 1 To 282

 word1 = Sheets("WORDS").Cells(i, 1)

 word2 = Sheets("WORDS").Cells(j, 1)

 k = 0

 For N = 2 To 111

 If Sheets("WORDS").Cells(i, N).Value * Sheets("WORDS").Cells(j, N).Value > 0 Then k = k + 1

 Next N

 If k >= 2 Then

 Sheets("PAIRS").Cells(pair, 1) = word1

 Sheets("PAIRS").Cells(pair, 2) = word2

 Sheets("PAIRS").Cells(pair, 3) = k

 pair = pair + 1

 End If

 Next j

 Next i

End Sub

Анализ картографических данных ( API Яндекс.Карт)

1) Карта с бассейнами

<!DOCTYPE html>

<html xmlns="http://www.w3.org/1999/xhtml">

<head>

<title>Map_pools</title>

<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />

<script src="https://api-maps.yandex.ru/2.1/?lang=ru_RU" type="text/javascript"></script>

<script type="text/javascript">

   ymaps.ready(init);

   var myMap,

       myPlacemark;

 

   function init(){

       myMap = new ymaps.Map("map", {

           center: [68.9724290781158,33.11475799999999],

           zoom: 6

       });

           

myPlacemark1 = new ymaps.Placemark([68.9724290781158,33.11475799999999], {hintContent: '3' }, {preset: 'islands#redIcon'});

       myMap.geoObjects.add(myPlacemark1);

myPlacemark2 = new ymaps.Placemark([69.19240738207901,33.24035599999998], {hintContent: '3' }, {preset: 'islands#redIcon'}); myMap.geoObjects.add(myPlacemark2);

myPlacemark3 = new ymaps.Placemark([69.19896526148374,33.45026999999998], {hintContent: '1' }); myMap.geoObjects.add(myPlacemark3);

myPlacemark4 = new ymaps.Placemark([67.58509790255333,33.41439999999992], {hintContent: '2' }, {preset: 'islands#greenIcon'});

       myMap.geoObjects.add(myPlacemark4);

myPlacemark5 = new ymaps.Placemark([69.39778566553332,32.43791799999998], {hintContent: '1' }); myMap.geoObjects.add(myPlacemark5);

myPlacemark6 = new ymaps.Placemark([67.5645936673213,30.48974149999997], {hintContent: '1' }); myMap.geoObjects.add(myPlacemark6);

myPlacemark7 = new ymaps.Placemark([68.81669477887728,32.79370000000002], {hintContent: '1' });

       myMap.geoObjects.add(myPlacemark7);

myPlacemark8 = new ymaps.Placemark([68.15453480235655,33.28510999999997], {hintContent: '1' }); myMap.geoObjects.add(myPlacemark8);

myPlacemark9 = new ymaps.Placemark([69.41207258476572,30.802319499999967], {hintContent: '2' }); myMap.geoObjects.add(myPlacemark9);

myPlacemark10 = new ymaps.Placemark([69.40992588037024,30.220444499999942], {hintContent: '1' });

       myMap.geoObjects.add(myPlacemark10);

myPlacemark11 = new ymaps.Placemark([67.41550971940632,32.48921149999994], {hintContent: '1' }); myMap.geoObjects.add(myPlacemark11);

myPlacemark12 = new ymaps.Placemark([67.93431871541323,32.89847949999997], {hintContent: '1' }); myMap.geoObjects.add(myPlacemark12);

myPlacemark13 = new ymaps.Placemark([67.63639745318433,33.724686999999996], {hintContent: '1' }); myMap.geoObjects.add(myPlacemark13);

myPlacemark14 = new ymaps.Placemark([[69.25415474552987,33.33110349999999]], {hintContent: '1' });

       myMap.geoObjects.add(myPlacemark14);

myPlacemark15 = new ymaps.Placemark([67.1632504881126,32.397632499999986], {hintContent: '1' }); myMap.geoObjects.add(myPlacemark15);

myPlacemark16 = new ymaps.Placemark([69.06746891051657,33.414139499999976], {hintContent: '1' }); myMap.geoObjects.add(myPlacemark16);

   }

</script>

</head>

 

<body>

<div id="map" style="width: 1000px; height: 800px"></div>

</body>

 

</html>

 

 


Поделиться с друзьями:

Общие условия выбора системы дренажа: Система дренажа выбирается в зависимости от характера защищаемого...

Механическое удерживание земляных масс: Механическое удерживание земляных масс на склоне обеспечивают контрфорсными сооружениями различных конструкций...

Поперечные профили набережных и береговой полосы: На городских территориях берегоукрепление проектируют с учетом технических и экономических требований, но особое значение придают эстетическим...

Папиллярные узоры пальцев рук - маркер спортивных способностей: дерматоглифические признаки формируются на 3-5 месяце беременности, не изменяются в течение жизни...



© cyberpedia.su 2017-2024 - Не является автором материалов. Исключительное право сохранено за автором текста.
Если вы не хотите, чтобы данный материал был у нас на сайте, перейдите по ссылке: Нарушение авторских прав. Мы поможем в написании вашей работы!

0.008 с.